Forum Discussion

Paneross's avatar
Paneross
Copper Contributor
Aug 28, 2019
Solved

How would I sort/filter this example? Excel 2016

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

  • 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

     

     

16 Replies

      • SergeiBaklan's avatar
        SergeiBaklan
        Diamond Contributor

        IngeborgHawighorst 

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

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

        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

        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

        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.

    • Subodh_Tiwari_sktneer's avatar
      Subodh_Tiwari_sktneer
      Silver Contributor

      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.

      • EricStarker's avatar
        EricStarker
        Former Employee

        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. 

  • 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

     

     

  • 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.

Resources