.display half working, .send bugs on email being sent on behalf of

Hello,

Code below uses an additional email account to outlook to send emails on behalf.
The code gives the option to either display the email or send, .display shows the email on the screen before sending, after hitting send the email gets sent but this message pops up ion the inbox: System Administrator: message did not reach some or all of the intended recipients.
When the code uses .send vba bugs and shows this message:
run time error, outlook does not recognize one or more names.

Private Sub CommandButton1_Click()

Dim OutApp As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Recipient
Dim Recipients As Recipients
Dim rcell As Long
Dim lr As Long
Dim ws As Worksheet
Dim TeamCC As String
Dim TeamBCC As String
Dim ClientCC As String
Dim Signature As String

Set OutApp = CreateObject("Outlook.Application")
Set objOutlookMsg = OutApp.CreateItem(olMailItem)
Set ws = Sheets("Recipients")

Signature = ws.Range("D2").Value

If ws.Range("B13") <> "" Then
    TeamCC = ws.Range("B13") & "; "
End If
If ws.Range("D13") <> "" Then
    TeamCC = TeamCC & ws.Range("D13") & "; "
End If
If ws.Range("F13") <> "" Then
    TeamCC = TeamCC & ws.Range("F13") & "; "
End If
If ws.Range("H13") <> "" Then
    TeamCC = TeamCC & ws.Range("H13") & "; "
End If

If ws.Range("B15") <> "" Then
    TeamBCC = ws.Range("B13") & "; "
End If
If ws.Range("D15") <> "" Then
    TeamBCC = TeamBCC & ws.Range("D15") & "; "
End If
If ws.Range("F15") <> "" Then
    TeamBCC = TeamBCC & ws.Range("F15") & "; "
End If
If ws.Range("H15") <> "" Then
    TeamBCC = TeamBCC & ws.Range("H15") & "; "
End If
        
lr = ws.Range("B" & Rows.Count).End(xlUp).Row

For rcell = 18 To lr
    If ws.Range("B" & rcell) <> "" Then

        If ws.Range("B" & rcell) <> "" Then
            ClientCC = ws.Range("B" & rcell) & "; "
        End If
        If ws.Range("D" & rcell) <> "" Then
            ClientCC = ClientCC & ws.Range("D" & rcell) & "; "
        End If
        If ws.Range("F" & rcell) <> "" Then
            ClientCC = ClientCC & ws.Range("F" & rcell) & "; "
        End If
        If ws.Range("H" & rcell) <> "" Then
            ClientCC = ClientCC & ws.Range("H" & rcell) & "; "
        End If

        Set Recipients = objOutlookMsg.Recipients
        Set objOutlookRecip = Recipients.Add(ClientCC)
        objOutlookRecip.Type = 1
        
        objOutlookMsg.SentOnBehalfOfName = ws.Range("B3").Value
        objOutlookMsg.Subject = ws.Range("B5").Value
        objOutlookMsg.CC = TeamCC
        objOutlookMsg.BCC = TeamBCC
        
        If ws.Range("A" & rcell) <> "" Then
            objOutlookMsg.HTMLBody = "Dear " & ws.Range("A" & rcell) & "," & "<br><br>" & ActiveWorkbook.Worksheets("Recipients").OLEObjects("TextBox1").Object.Value & Signature
        Else
            objOutlookMsg.HTMLBody = "Dear Sir," & ws.Range("A" & rcell) & "," & "<br><br>" & ActiveWorkbook.Worksheets("Recipients").OLEObjects("TextBox1").Object.Value & Signature
        End If
        
        For Each objOutlookRecip In objOutlookMsg.Recipients
            objOutlookRecip.Resolve
        Next
        
        If ActiveWorkbook.Worksheets("Recipients").OLEObjects("CheckBox1").Object.Value = True Then
            objOutlookMsg.Send
        Else
            objOutlookMsg.Display
        End If
        
        Set OutApp = Nothing
    End If
Next

End Sub