Previous Topic Next Topic

Convert rows to cols

Closed
Report
-
Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
 -
Hello,

I have an example as below

A cac 20
A dwp 22
B cac 15
B dwp 22
B erp 20


I want output as

A CAC 20 DWP 22
B CAC 15 DWP 22 ERP 20

I want to macro to convert the above and the same criteria should be Extended to 1000's of lines.

Please let me know the solution ASAP.

1 reply

Answer 1 / 1
Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
 804
main data from A1 to C6 is as follows

hdng1 hdng2 hdng3
A cac 20
A dwp 22
B cac 15
B dwp 22
B erp 20

try this macro "test" (park both macros in a module)
the result is five rows below the main data in the same sheet1 

Sub test()
    Dim ra As Range, rdata As Range, filt As Range, j As Long, k As Long
    Dim r1 As Range, cr1 As Range, m As Long, n As Long
    undo
    Worksheets("sheet1").Activate
    Set ra = Range(Range("A1"), Range("a1").End(xlDown))
    Set r1 = Range("A1").End(xlDown).Offset(5, 0)
    Set rdata = Range("A1").CurrentRegion
    ra.AdvancedFilter xlFilterCopy, , r1, True
    Set r1 = Range(r1.Offset(1, 0), r1.End(xlDown))

    For Each cr1 In r1
        rdata.AutoFilter field:=1, Criteria1:=cr1.Value
        Set filt = rdata.Offset(1, 0).Resize(rdata.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
        j = filt.Areas.Count

        For k = 1 To j
            m = filt.Areas(k).Rows.Count
            For n = 1 To m
                filt.Areas(k).Range(Cells(n, 2), Cells(n, 3)).Copy Cells(cr1.Row, Columns.Count).End(xlToLeft).Offset(0, 1)
            Next n
        Next k
        ActiveSheet.AutoFilterMode = False
    Next cr1
End Sub



Sub undo()
    Worksheets("sheet1").Activate
    Range(Range("A1").End(xlDown).Offset(1, 0), Cells(Rows.Count, "A")).EntireRow.Delete

End Sub
0
Ask a question