Forum Discussion
Paneross
Aug 28, 2019Copper Contributor
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...
- Aug 29, 2019
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
Aug 29, 2019Copper Contributor
Subodh_Tiwari_sktneer
Aug 30, 2019Silver Contributor
You're welcome again!