Debug problem with mid statement

Here's the code:

Sub ExtractEmails()

Dim RowCounter As Double
Dim ColCounter As Double
Dim MaxRow As Double
Dim SearchString As String
Dim SearchMatch As String
Dim EmailAddress As String
Dim StartEmailChar As Integer
Dim EndEmailChar As Integer
Dim LengthofName As Integer

Range("A2").Activate

'Place cursor in first cell to have email extracted

RowCounter = ActiveCell.Row
ColCounter = ActiveCell.Column

'Insert Maxrow value
MaxRow = 14


For RowCounter = 1 To MaxRow - 1
        SearchString = Cells(RowCounter, ColCounter)
        SearchChar = "E-mail:"
        StartEmailChar = InStr(1, SearchString, SearchChar, 1) + 7
        EndEmailChar = InStr(StartEmailChar, SearchString, "", 1)
        LengthofName = EndEmailChar - StartEmailChar
        'LengthofName = 7


        'Problem is with the following statement

        EmailAddress = Mid(SearchString, StartEmailChar, LengthofName) 
        
        Cells(MaxRow + RowCounter, ColCounter) = EmailAddress
       
    Next RowCounter
    
End Sub

Here is the error:
Macro error.jpg

Here is the data: (the information is bogus and not that of a real customer)
Data example.jpg

I am trying to extract the email address from a long string with leading blanks? in column B. The email address is then written to column B one row below the data array. About 3000 records.