How to look up each value from one column and return email addresses with ";" separator

Question

This was solved using a formula.
Unfortunately, I need a solution that works in Excel 2016, and it seems VBA is the best/only route.

Legend: (this is across multiple worksheets in the same workbook)
Each column has a header.
Column A of Sheet3: List of Names
Column H of Sheet3: List of Email Addresses
Column M of Sheet1: contains the below formula dragged down, which produces a variable number of rows of data: =IFERROR(INDEX($A$2:$A$42,MATCH(0,IF("1"=$L$2:$L$42,COUNTIF($O$1:$O1,$A$2:$A$42),""),0)),"")

In column M of Sheet1, I have an Index/Match formula, which populates with a list of people's names. (As said above, the number of names that appear is ever-changing.)

I'd like to look up each name that appears in column M of Sheet1 against column A of Sheet3 then return the respective email address from column H of Sheet3.

Additionally, I'd like to separate each email address with a semicolon, as this is to populate the To field of an Outlook email.

Snapshot of what the data looks like

| A, Sheet3       | H, Sheet3                | M, Sheet1     |
| --------------- | ------------------------ | ------------- |
| John Smith      | JohnSmith@email.com      | Frank Sinatra |
| Kimberly Jones  | Kimberly@email.com       | Corey Smith   |
| Joe Montana     | JoeMontana@email.com     | Kimberly Jones|
| Dean Martin     | DeanMartin@email.com     | John Smith    |
| Corey Smith     | Corey.Smith@email.com    |               |
| Frank Sinatra   | Frank.Sinatra@email.com  |               |

In cell F2 of Sheet1, the macro would produce the below:

Frank.Sinatra@email.com; Corey.Smith@email.com; Kimberly@email.com; JohnSmith@email.com      

Worksheet tab names:

Worksheet1:

Worksheet3:

Answer 1

Try,

Function JoinEmail() As String
    Dim Ws(1 To 2) As Worksheet
    Dim vDB As Variant, vR() As Variant
    Dim vName As Variant
    Dim Dic As Object  'Dictionary
    Dim i As Long, n As Integer
    Dim s As String
    
    Set Ws(1) = Sheets(1)
    Set Ws(2) = Sheets(3)
    
    Set Dic = CreateObject("Scripting.Dictionary")
    
    vDB = Ws(2).UsedRange 'Sheets(3) data
    With Ws(1)
        vName = .Range("M2", .Range("M" & Rows.Count).End(xlUp))
    End With
    
    For i = 2 To UBound(vDB, 1)
        Dic.Add vDB(i, 1), vDB(i, 8) 'name, email
    Next i
    
    For i = 1 To UBound(vName, 1)
        s = vName(i, 1)
        If Dic.Exists(s) Then
            n = n + 1
            ReDim Preserve vR(1 To n)
            vR(n) = Dic(s)
        End If
    Next i
    If n Then
        JoinEmail = Join(vR, "; ")
    Else
        JoinEmail = ""
    End If
    
End Function

Sheet1 image

Sheet3 image