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

     

     

Resources