Aug 28 2019 11:15 AM
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
Aug 28 2019 05:49 PM
@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.
Aug 28 2019 10:22 PM - edited Aug 28 2019 10:25 PM
Solution
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
Aug 29 2019 05:11 AM
@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!
Aug 29 2019 05:16 AM
Aug 29 2019 05:27 AM
Aug 29 2019 05:33 AM
@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.
Aug 29 2019 06:18 AM
@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!
Aug 29 2019 07:51 AM
Can you show me where I criticized your solution?
I am reporting this comment as a rude comment.
Aug 29 2019 08:39 AM
@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.
Aug 29 2019 09:00 AM
Sorry Eric if I violated the code of conduct. Please accept my apologies.
Aug 29 2019 12:32 PM
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
Aug 29 2019 12:54 PM
Aug 29 2019 07:10 PM
@nabilmourad Maybe you can post the Power Query approach? That would help people who don't want to delve in to VBA.
Aug 29 2019 08:31 PM
You're welcome again!
Aug 30 2019 05:39 AM
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.
Aug 28 2019 10:22 PM - edited Aug 28 2019 10:25 PM
Solution
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