Q:

List all matching values in a comma separated list?

I have 2 worksheets:
Worksheet 1:
Column C            Column D
Supplier A          Fish
Supplier A          Meat
Supplier B          Bread

Worksheet 2:
Column C            Column F
Supplier A
Supplier B

In column F I want to create a list of all the items that match the supplier.
So for example:
Column C         Column F  
Supplier A       Fish, Meat
Supplier B       Bread

I am using the following vba function:
Function SingleCellExtract(LookupValue As String, LookupRange As Range, LookupCol As Long, ReturnCol As Long, Char As String)
'Updateby20150824
    Dim varTMP As Variant, I As Long
    varTMP = LookupRange
    Dim xRet As String
    For I = 1 To UBound(varTMP, 1)
        If varTMP(I, LookupCol) = LookupValue Then
            If xRet = "" Then
                xRet = varTMP(I, ReturnCol)
            Else
                xRet = xRet & Char & varTMP(I, ReturnCol)
            End If
        End If
    Next
    SingleCellExtract = xRet
End Function

And this formula in column F
=SingleCellExtract(C1,Data!D:D,-1,",")

The actual code works fine, but I want to eradicate the need to 'drag' a formula down column F to produce the result. Is there a way I can improve the code to bypass the need for the formula and just have something like:
Range F1 = 'Comma Separated List'
Next Cell in column F
etc...

A:

you could use a macro and exploit Dictionary object
Sub Main()
    Dim cell As Range

    With CreateObject("Scripting.Dictionary")
        For Each cell In Worksheets("Sheet1").Range("C1", Worksheets("Sheet1").Cells(Rows.count, "C").End(xlUp))
            .item(cell.Value) = .item(cell.Value) & cell.Offset(, 1).Value & ","
        Next
        For Each cell In Worksheets("Sheet2").Range("C1", Worksheets("Sheet2").Cells(Rows.count, "C").End(xlUp))
            MsgBox .item(cell.Value)
            cell.Offset(, 3).Value = Left(.item(cell.Value), Len(.item(cell.Value)) - 1)
        Next
    End With
End Sub

