Hi..
Just a small change/addition needed.. (shown in red)..
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim x As Range, i As Long
With Sheets("Before").Range("A1").CurrentRegion
For i = 3 To Range("B" & Rows.Count).End(xlUp).Row + 1
If Cells(i, 1).Value = "" And Cells(i, 2).Value <> "" Then
Cells(i, 1).FormulaR1C1 = "=R[-1]"
Else
.AutoFilter 1, Cells(i, 1).Offset(-1).Value
Set x = .Offset(1, 1).Resize(.Rows.Count - 1, 1).SpecialCells(12)
If .SpecialCells(12).Count > 6 Then
Cells(x.Row, 3).Value = Join(Application.Transpose(x.Value), ",")
Else
Cells(x.Row, 3).Value = x.Value
End If
End If
Next i
.AutoFilter
Columns(1).SpecialCells(-4123).Value = ""
End With
Application.ScreenUpdating = True
End Sub
Bookmarks