Forum Discussion

Scott Haefele's avatar
Scott Haefele
Copper Contributor
Aug 09, 2018

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 Chan's avatar
    Man Fai Chan
    Iron 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 Sub

     

    You need to use the attached file for running the macro. 

Resources