VBA to send email if a cell value equals the value in another cell

I have a worksheet set up in which in column E I have a list of email addresses – what I’d like to do is send an email to these only if the value in column B (the table starts from row 6) equals a value entered into cell B4.

I have tried tweaking the below code but I can’t get it to only pull through any emails that match this criteria.

  Sub ClubEmails()
        Dim OutApp As Object
        Dim OutMail As Object
        Dim lLastRow As Long
        Dim lRow As Long
        Dim rng As Range
        
        Dim strbody As String
        Dim xOutlook
        Dim xMailItem
        Dim xEmailAddr
        
        
        strbody = "Text goes here"
        
        lLastRow = Cells(Rows.Count, 2).End(xlUp).row
        For lRow = 2 To lLastRow
            If Cells(lRow, 2) = Range("B4").Value Then
                               
                    Set xOutlook = CreateObject("Outlook.Application")
                    Set xMailItem = xOutlook.CreateItem(0)
                                    
                     
                    Set rng = Range("E6:E" & lRow)
                    xEmailAddr = Join(WorksheetFunction.Transpose(rng), ",")
         
                    On Error Resume Next
                    With xMailItem
                        .To = ""
                        .CC = ""
                        .BCC = xEmailAddr
                        .Subject = "Test Email"
                        .HTMLBody = strbody
                        .Display
                    End With
                    MsgBox "E-mail successfully created", 64
                    Application.DisplayAlerts = False
                    
                End If
           
        Next
        Set OutApp = Nothing
    End Sub

Currently it will just pull the emails in column E through regardless of the cell value in column B matching the entry in cell B4.

>Solution :

I believe it will be easier to just create a string with all the emails then pass this to outlook instead of using a range inside a loop.

Sub ClubEmails()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim lLastRow As Long
    Dim lRow As Long
    Dim rng As Range
    
    Dim strbody As String
    Dim xOutlook
    Dim xMailItem
    Dim xEmailAddr As String
    
    
    strbody = "Text goes here"
    xEmailAddr = ""
    
    For lRow = 6 To Cells(Rows.Count, 2).End(xlUp).row ' is it 6 or not?
        If Cells(lRow, 2).Value = Range("B4").Value Then
            xEmailAddr = Range("E" & lRow).Value & ", " & xEmailAddr 
        End If
    Next
    Set xOutlook = CreateObject("Outlook.Application")
    Set xMailItem = xOutlook.CreateItem(0)

    With xMailItem
        .To = ""
        .CC = ""
        .BCC = Left(xEmailAddr , Len(xEmailAddr ) - 2) ' remove the trailing comma
        .Subject = "Test Email"
        .HTMLBody = strbody
        .Display
    End With
    MsgBox "E-mail successfully created", 64
    Application.DisplayAlerts = False ' is this supposed to be here at the end?

    Set OutApp = Nothing
End Sub