Forum Discussion
Scott Haefele
Aug 09, 2018Copper Contributor
Looking for Macro Design Help for Specific Problem
Hello,
I'm looking for a solution that takes raw data and divides it into sections based on category numbers, and creates headers to separate these sections. I've attached an example of what I'd like to have happen.
Thanks,
Scott
- Man Fai ChanIron Contributor
I think the following macro may help:
Sub Gen_Table()
Set MS = Sheets("MS")
Set RS = Sheets("RS")
RS.Range("K:M").Delete
RS.Range("K:M").ColumnWidth = 12
' Reset the output region
MS.Range("A:B").Sort _
key1:=MS.Range("B1"), order1:=xlAscending, _
Header:=xlYes
r_MS = 2
r_RS = 0
Do While 1 = 1
If Len(MS.Cells(r_MS, 1)) = 0 Then Exit Do
' criteria to quit the loop
If MS.Cells(r_MS - 1, 2) <> MS.Cells(r_MS, 2) Then
r_RS = r_RS + 1
RS.Range("B11") = MS.Cells(r_MS, 2)
RS.Cells(r_RS, 11) = RS.Range("B12")
RS.Range("K" & r_RS & ":M" & r_RS).Borders.LineStyle = xlContinuous
RS.Range("K" & r_RS & ":M" & r_RS).Merge
' Header : 1st row
r_RS = r_RS + 1
For j = 1 To 3
RS.Cells(r_RS, j + 10) = MS.Cells(1, j + 2)
Next j
RS.Range("K" & r_RS & ":M" & r_RS).Borders.LineStyle = xlContinuous
' Header : 2nd row
End If
r_RS = r_RS + 1
For j = 1 To 3
RS.Cells(r_RS, j + 10) = MS.Cells(r_MS, j + 2)
Next j
RS.Range("K" & r_RS & ":M" & r_RS).Borders.LineStyle = xlContinuous
' Information
r_MS = r_MS + 1
Loop
MS.Range("A:B").Sort _
key1:=MS.Range("A1"), order1:=xlAscending, _
Header:=xlYes
End SubYou need to use the attached file for running the macro.