Hi Scott
Only just spotted your request.
I think the attached file with the modified code as below does what you want.
Sub CollectInvoices()
Dim i As Long, lrd As Long, lrm As Long
Dim str As String, R As Range, start As String
Dim wsd As Worksheet, wsm As Worksheet
Set wsd = Sheets("All data entry")
Set wsm = Sheets("Summary")
Application.EnableEvents = False
lrd = wsd.Cells(Rows.Count, "K").End(xlUp).Row
lrm = wsm.Cells(Rows.Count, "G").End(xlUp).Row
For i = 1 To lrm
wsd.Activate
With wsd.Range("K2:K" & lrd)
Set R = .Find(i, , xlValues, xlWhole)
If Not R Is Nothing Then
start = R.Address
R.Select
Do
If InStr(str, R.Offset(0, 2).Value) < 1 Then
str = str & R.Offset(0, 2).Value & ", "
End If
Set R = .FindNext(R)
Loop While Not R Is Nothing And R.Address <> start
End If
End With
If Not str = "" Then
wsm.Cells(i + 9, "L") = Left(str, Len(str) - 2)
str = ""
End If
Next
Application.EnableEvents = True
End Sub
Bookmarks