Help writing a small VBA module in Excel

Dim r0 as Integer,1. Ensure your data is always being sorted by Client column.
2. Have a loop to read  every row, and to create output into another sheet


Sub Copy_data()
   Dim r0 as Integer， r1 as Integer, Val_hold as String, Val_hold2 as String
   r1 = 1: r0 = 2： Val_hold = ""
   Worksheets("S1").Cells(1, 1).Value = "Client": Worksheets("S1").Cells(1, 2).Value = "Affiliation"
   Do While Worksheets("S0").Cells(r0, 1).Value <> ""
      If Val_hold <> Worksheets("S0").Cells(r0, 1).Value Then
         r1 = r1 +1
         Worksheets("S1").Cells(r1, 1).Value = Worksheets("S1").Cells(r0, 1).Value
         Worksheets("S1").Cells(r1, 2).Value = Worksheets("S1").Cells(r0, 2).Value
      Else
         Worksheets("S1").Cells(r1, 1).Value = Worksheets("S1").Cells(r1, 1).Value & ", " & Worksheets("S1").Cells(r0, 1).Value
      End If


      Val_hold = Worksheets("S0").Cells(r0, 1).Value
      r0=r0 + 1


   Loop
End Sub

Select allOpen in new window

Sub GroupClients()
Dim lngLastRow As Long
Dim lngRow As Long
Dim ws As Worksheet
Dim colClients As New Collection
Dim lngEntry As Long
Const CLIENT_COL As Integer = 1
Const TEMP_COL As Integer = 26 ' 26 is column Z and I use Z and AA temporarily to store the merge results

Set ws = ActiveSheet

Application.ScreenUpdating = False

With ws
    lngLastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    ' Clear columns Z and AA 
    .Columns(TEMP_COL).ClearContents
    .Columns(TEMP_COL + 1).ClearContents

    .Columns(TEMP_COL).NumberFormat = "@" ' This line sets the cells in column Z to Text format
    .Columns(TEMP_COL + 1).NumberFormat = "@" ' This line sets the cells in column AA to Text format
    
   ' Loop through the data creating a keyed collection of unique Client values
    For lngRow = 2 To lngLastRow
        ' Collections that have keys throw an error if the addition of a duplicate key is attempted.
        ' The On Error suppresses the error message that would otherwise occur
        On Error Resume Next
        ' The format is collectionname.Add collection.value, collection.key
        colClients.Add .Cells(lngRow, CLIENT_COL), CStr(.Cells(lngRow, CLIENT_COL))
        On Error GoTo 0
    Next
    
    ' Loop through each row
    For lngRow = 2 To lngLastRow
        ' Loop through each member in the collection (collections start at 1)
        For lngEntry = 1 To colClients.Count
            If .Cells(lngRow, CLIENT_COL) = colClients(lngEntry) Then
                ' A Client is found that matches to collection key
                If Not IsEmpty(.Cells(lngEntry + 1, TEMP_COL)) Then
                    ' There's already data in column Z for the collection key so add the concatenate the value in column AA (which is CLIENT_COL + 1
                    ' with the data from the current Client row
                    .Cells(lngEntry + 1, TEMP_COL + 1) = .Cells(lngEntry + 1, TEMP_COL + 1) & ", " & .Cells(lngRow, CLIENT_COL + 1)
                Else
                    '  It's the first time we are dealing with a Client so just copy the data from columns A and B to Z and AA  
                    .Cells(lngEntry + 1, TEMP_COL) = .Cells(lngRow, CLIENT_COL)
                    .Cells(lngEntry + 1, TEMP_COL + 1) = .Cells(lngRow, CLIENT_COL + 1)
                End If
                Exit For
            End If
        Next
    Next
    .Range(.Cells(2, CLIENT_COL), .Cells(lngLastRow, CLIENT_COL + 1)).ClearContents
    
    For lngRow = 2 To colClients.Count + 1
        .Cells(lngRow, CLIENT_COL) = .Cells(lngRow, TEMP_COL)
        .Cells(lngRow, CLIENT_COL + 1) = .Cells(lngRow, TEMP_COL + 1)
    Next
    ' A better way of clear columns Z and AA 
    .Range(.Cells(2, TEMP_COL), .Cells(lngLastRow, TEMP_COL + 1)).ClearContents

End With

Application.ScreenUpdating = True

End Sub

Select allOpen in new window