Change from Public Function to Sub - excel

Question

I have been using the below code to run a vlookup-style search and return all matches (whilst omitting duplicates and blanks). I want to convert this into a VBA macro that I can call using a button to, by row, search for the value in column C in column A, and return each corresponding value from column B. I want these results printed in column D, separated by a ";". Does anyone know a good way to do this? I've also attached an example image of my goal output.
Thanks!
Public Function Vlookup2(ByVal Lookup_Value As String, ByVal Cell_Range As
Range, ByVal Column_Index As Integer) As Variant
Dim cell As Range
Dim Result_String As String
On Error GoTo eHandle
For Each cell In Cell_Range
If cell.Value = Lookup_Value Then
If cell.Offset(0, Column_Index - 1).Value <> "" Then
If Not Result_String Like "*" & cell.Offset(0, Column_Index - 1).Value & "*" Then
Result_String = Result_String & ";!;" & cell.Offset(0, Column_Index - 1).Value
End If
End If
End If
Next cell
Vlookup2 = LTrim(Right(Result_String, Len(Result_String) - 1))
Exit Function
eHandle:
Vlookup2 = ""
End Function

Answer 1

Here's one approach you could try:
Sub SummarizeAddresses()
Dim dict As Object, c As Range, ws As Worksheet
Dim pc As String, addr As String, k
Set dict = CreateObject("scripting.dictionary")
Set ws = ActiveSheet 'or whatever
'loop over the input data
For Each c In ws.Range("A2:A" & ws.Cells(Rows.Count, "A").End(xlUp).Row).Cells
pc = Trim(c.Value)
addr = c.Offset(0, 1).Value
If Not dict.exists(pc) Then Set dict(pc) = New Collection 'new code?
On Error Resume Next 'ignore error if adding a duplicate
dict(pc).Add addr, addr
On Error GoTo 0 'stop ignoring errors
Next c
Set c = ws.Range("C2") 'starting point for output
For Each k In dict
c.Value = k
c.Offset(0, 1).Value = CollectionItems(dict(k))
Set c = c.Offset(1, 0) 'next row down
Next k
End Sub
'return a string with all elements of a collection
Function CollectionItems(col As Collection)
Dim rv As String, e, sep As String
For Each e In col
rv = rv & sep & e
sep = ";"
Next e
CollectionItems = rv
End Function