Using a macro to convert groups of rows to columns

Hi RHCPgergo,

I've tried the pivot table option too. Tried a few different combinations using the data, but not quite what I was looking for.

I need this to be able to setup a mail merge, so need the titles across the page.

Thanks for your reply though.

LittleLisa

Hi again,

I hope this is what you wanted, had quite a lot of work with it. I learned a lot though, so thanks for the opportunity.

' Function taken from http://www.vb-helper.com/howto_in_array_test.html. Thanks a lot!
Public Function ArrayContainsLoop(values() As String, ByVal target As String) As Boolean
Dim i As Integer

    ' Assume we will find the target.
    ArrayContainsLoop = True
    For i = LBound(values) To UBound(values)
        If values(i) = target Then Exit Function
    Next i

    ' We didn't find the target.
    ArrayContainsLoop = False
End Function


Sub ReArrangeData()

' Assuming columns A,B,C are containing Name, No., Group respectively and data is starting from row 2. (column headings in row 1)

Dim MyArray() As String
Dim Trial As Variant
Dim c As Integer, a, x, y
Dim Group As String
Dim Sht As Worksheet
Dim Sht2 As Worksheet
Application.ScreenUpdating = False

Set Sht = ActiveSheet
Set Sht2 = Worksheets.Add
Sht2.Name = "Output"

ReDim Preserve MyArray(0)
MyArray(0) = "placeholder"
For c = 2 To Sht.Cells(Rows.Count, "A").End(xlUp).Row
    Group = Sht.Cells(c, 3).Value
    If ArrayContainsLoop(MyArray(), Group) = False Then
        ReDim Preserve MyArray(a)
        MyArray(a) = Group
        Sht2.Cells(a + 1, 1).Value = Group
        Sht2.Cells(a + 1, 2).Value = Sht.Cells(c, 1)
        Sht2.Cells(a + 1, 3).Value = Sht.Cells(c, 2)
        a = a + 1
    Else
        Sht2.Cells(Application.Match(Group, MyArray, False), Columns.Count).End(xlToLeft).Offset(0, 1) = Sht.Cells(c, 1).Value
        Sht2.Cells(Application.Match(Group, MyArray, False), Columns.Count).End(xlToLeft).Offset(0, 1) = Sht.Cells(c, 2).Value
    End If
Next c

With Sht2
    .Rows(1).Insert
    .Range("A1") = "Groups"
    .Range("1:1").Font.Bold = True
    For x = 1 To (.UsedRange.Columns.Count - 1) Step 2
        .Cells(1, 1 + x) = "Name " & y + 1
        .Cells(1, 2 + x) = "No. " & y + 1
        y = y + 1
    Next x
End With

Application.ScreenUpdating = True

End Sub

Hi RHCPgergo,

OMG! You are amazing!!

Problem solved.

Thanks so much for that, you don't know how much trouble you have saved me.

LittleLisa

Yay!

I' m glad it works for you.

@ LittleLisa

Welcome to the forum.

Based on your last post it seems that you are satisfied with the solution(s) you've received but you haven't marked your thread as SOLVED. I'll do that for you now but please keep in mind for your future threads that Rule #9 requires you to do that yourself. If your problem has not been solved you can use Thread Tools (located above your first post) and choose "Mark this thread as unsolved".
Thanks.

Also, as a new member of the forum, you may not be aware that you can thank those who have helped you by clicking the small star icon located in the lower left corner of the post in which the help was given. By doing so you can add to the reputation(s) of those who helped.