SOLVED

How would I sort/filter this example? Excel 2016

Copper Contributor

Excel Example.png

Hello guys, I'm in need of some excel expertise. I've attached a sample picture of what my current spreadsheet looks like.

 

What I'm trying to do:  I have multiple abbreviations with an amount under columns B through G. 

I'm trying to sort all the JACM/CLAM/WYAK/etc and the numbers below them into their own column,  and I'm having alot of trouble doing so. I want Column B to be all JACM, C to be all WYAK, etc but still be lined up on correct guys under row A.

 

Thanks, sorry for the confusing explanation

16 Replies

@Paneross The problem here is that you have entered data into a report structure, and on top of that used inconsistent column patterns. This data is now really hard to handle, and re-arranging it will be tedious and most likely, manual.

 

A far better data entry structure would be just three columns, i.e. name, type, and value. From such a flat table you can then easily build the desired report with the data arranged as you describe.

best response confirmed by Paneross (Copper Contributor)
Solution

@Paneross 

 

I have used VBA approach to get the data in the desired format.

In the attached, click the button called "Transform Data" on Sheet1 to run the code. You will be prompted to select the range with data and the code will insert a new sheet called "Output" with the data in the desired format.

 

Sub TransformData()
Dim wsOutput    As Worksheet
Dim rng         As Range
Dim x           As Variant
Dim y()         As Variant
Dim i           As Long
Dim j           As Long
Dim r           As Long
Dim c           As Long
Dim n           As Variant

On Error Resume Next
Set rng = Application.InputBox("Please select the Range with Data.", Type:=8)

If rng Is Nothing Then
    MsgBox "You didn't select any Range.", vbExclamation
    Exit Sub
End If

Application.ScreenUpdating = False
Application.DisplayAlerts = False

ThisWorkbook.Worksheets("Output").Delete
On Error GoTo 0

x = rng.Value
ReDim y(1 To UBound(x, 1) * UBound(x, 2), 1 To 1)

r = 1
c = 1

For i = 1 To UBound(x, 1)
    For j = 2 To UBound(x, 2)
        If IsNumeric(x(i, j)) And x(i, j) > 0 Then
            n = Application.Match(x(i - 1, j), Application.Index(y, 1, 0), 0)
            If IsError(n) Then
                r = r + 1
                c = c + 1
                ReDim Preserve y(1 To UBound(x, 1) * UBound(x, 2), 1 To c)
                y(r, 1) = x(i - 1, 1)
                y(1, c) = x(i - 1, j)
                y(r, c) = x(i, j)
            Else
                r = r + 1
                y(r, 1) = x(i - 1, 1)
                y(r, n) = x(i, j)
                
            End If
        End If
    Next j
Next i
Set wsOutput = ThisWorkbook.Worksheets.Add(after:=rng.Parent)
wsOutput.Name = "Output"
With wsOutput.Range("A1").Resize(r, c)
    .Value = y
    .NumberFormat = "0.00"
    .Columns(1).AutoFit
    .Borders.Color = vbBlack
End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

 

@Subodh_Tiwari_sktneer  that was exactly what I was looking for! Thank you so much, you don't realize how much this will help now and in the future. I truly appreciate it!

@Paneross 

This is an optimum situation for using Power Query, just few clicks.

Good luck

Nabil Mourad

@Paneross 

 

You're welcome! Glad it worked as desired!

@nabilmourad 

 


@nabilmourad wrote:

This is an optimum situation for using Power Query, just few clicks.

This is absolutely pointless to criticize the accepted solution instead of posting your own solution., that makes no sense.

@Subodh_Tiwari_sktneer  You've been a great help, would you mind helping with this last question then I think I'll be set for a very long time. Now that I got the data sorted using the code provided, I've noticed I have duplicates, (see example "Problem Table"), now I'm trying to merge multiple entries in Column A, with the B:M data into one row. I've tried merging, subtotaling, and played with a pivot table and wasn't able to merge the rows, and get rid of the duplicates. Thanks!Problem Table.pngEnd Goal.png

@Subodh_Tiwari_sktneer 

 

Can you show me where I criticized your solution?

I am reporting this comment as a rude comment.

 

@Subodh_Tiwari_sktneer Hello, our moderation team has reviewed this and seems like a misunderstanding. Offering different advice to what's been accepted is not the same as criticizing that previous advice. Check out our code of conduct if you have any questions. 

@Eric Starker 

Sorry Eric if I violated the code of conduct. Please accept my apologies.

@Paneross 

 

In that case, you may try this...

 

Sub TransformData()
Dim wsOutput    As Worksheet
Dim rng         As Range
Dim x           As Variant
Dim y()         As Variant
Dim i           As Long
Dim j           As Long
Dim r           As Long
Dim c           As Long
Dim n           As Variant
Dim m           As Variant

On Error Resume Next
Set rng = Application.InputBox("Please select the Range with Data.", Type:=8)

If rng Is Nothing Then
    MsgBox "You didn't select any Range.", vbExclamation
    Exit Sub
End If

Application.ScreenUpdating = False
Application.DisplayAlerts = False

ThisWorkbook.Worksheets("Output").Delete
On Error GoTo 0

x = rng.Value
ReDim y(1 To UBound(x, 1) * UBound(x, 2), 1 To 1)

r = 1
c = 1

For i = 1 To UBound(x, 1)
    For j = 2 To UBound(x, 2)
        If IsNumeric(x(i, j)) And x(i, j) > 0 Then
            If i > 1 Then m = Application.Match(x(i - 1, 1), Application.Index(y, 0, 1), 0)
            n = Application.Match(x(i - 1, j), Application.Index(y, 1, 0), 0)
            If IsError(n) Then
                c = c + 1
                ReDim Preserve y(1 To UBound(x, 1) * UBound(x, 2), 1 To c)
                If IsError(m) Then
                    r = r + 1
                    y(r, 1) = x(i - 1, 1)
                    y(r, c) = x(i, j)
                Else
                    y(m, c) = x(i, j)
                End If
                y(1, c) = x(i - 1, j)
            Else
                If IsError(m) Then
                    r = r + 1
                    y(r, n) = x(i, j)
                Else
                    y(m, n) = x(i, j)
                End If
                y(r, 1) = x(i - 1, 1)
            End If
        End If
    Next j
Next i

Set wsOutput = ThisWorkbook.Worksheets.Add(after:=rng.Parent)
wsOutput.Name = "Output"

With wsOutput.Range("A1").Resize(r, c)
    .Value = y
    .NumberFormat = "0.00"
    .Columns(1).AutoFit
    .Borders.Color = vbBlack
End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

 

@Subodh_Tiwari_sktneer 

 

You sir have saved the day, thank you very much!

@nabilmourad Maybe you can post the Power Query approach? That would help people who don't want to delve in to VBA.

@Paneross 

You're welcome again!

@Ingeborg Hawighorst 

If with Power Query. To simplify I took the source as the table, not as named range.

image.png

In Power Query for the source table index every odd/even row

image.png

When reference it and, if only main steps, filter only rows with codes, unpivot other than names columns, add index, after that sort by codes and names

image.png

Another reference with exactly same steps, but here the only select numbers. Merge first reference with second one on index, extract numbers only from column with tables from second reference. It looks like

image.png

Pivot it on codes for Value.1 without aggregation and load result into Excel.

 

With some coding that could be done more compact and combined in one query, but I tried to use UI only.

More details are in attached file.

1 best response

Accepted Solutions
best response confirmed by Paneross (Copper Contributor)
Solution

@Paneross 

 

I have used VBA approach to get the data in the desired format.

In the attached, click the button called "Transform Data" on Sheet1 to run the code. You will be prompted to select the range with data and the code will insert a new sheet called "Output" with the data in the desired format.

 

Sub TransformData()
Dim wsOutput    As Worksheet
Dim rng         As Range
Dim x           As Variant
Dim y()         As Variant
Dim i           As Long
Dim j           As Long
Dim r           As Long
Dim c           As Long
Dim n           As Variant

On Error Resume Next
Set rng = Application.InputBox("Please select the Range with Data.", Type:=8)

If rng Is Nothing Then
    MsgBox "You didn't select any Range.", vbExclamation
    Exit Sub
End If

Application.ScreenUpdating = False
Application.DisplayAlerts = False

ThisWorkbook.Worksheets("Output").Delete
On Error GoTo 0

x = rng.Value
ReDim y(1 To UBound(x, 1) * UBound(x, 2), 1 To 1)

r = 1
c = 1

For i = 1 To UBound(x, 1)
    For j = 2 To UBound(x, 2)
        If IsNumeric(x(i, j)) And x(i, j) > 0 Then
            n = Application.Match(x(i - 1, j), Application.Index(y, 1, 0), 0)
            If IsError(n) Then
                r = r + 1
                c = c + 1
                ReDim Preserve y(1 To UBound(x, 1) * UBound(x, 2), 1 To c)
                y(r, 1) = x(i - 1, 1)
                y(1, c) = x(i - 1, j)
                y(r, c) = x(i, j)
            Else
                r = r + 1
                y(r, 1) = x(i - 1, 1)
                y(r, n) = x(i, j)
                
            End If
        End If
    Next j
Next i
Set wsOutput = ThisWorkbook.Worksheets.Add(after:=rng.Parent)
wsOutput.Name = "Output"
With wsOutput.Range("A1").Resize(r, c)
    .Value = y
    .NumberFormat = "0.00"
    .Columns(1).AutoFit
    .Borders.Color = vbBlack
End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

 

View solution in original post