looping through outlook emails to update excel spreadsheet by finding specific string in email body

i am trying to loop through the sent folder in outlook and update my spreadsheet with the 'received time" of an email..my spreadsheet has a column that contain record number, each emails contain one or more record numbers, if the email body has a matching record then i want to extract the received date and put it in a column, i believe the issue is with my If statement :

 
Option Explicit

 

Private Sub CommandButton1_Click()

    On Error GoTo ErrHandler

   

    ' Set Outlook application object.

    Dim objOutlook As Object

    Set objOutlook = CreateObject("Outlook.Application")

   

    Dim objNSpace As Object     ' Create and Set a NameSpace OBJECT.

    ' The GetNameSpace() method will represent a specified Namespace.

    Set objNSpace = objOutlook.GetNamespace("MAPI")

    

    Dim myFolder As Object  ' Create a folder object.

    Set myFolder = objNSpace.GetDefaultFolder(olFolderSentMail)

   

    Dim objItem As Object

    Dim iRows, iCols As Integer

    Dim sFilter As String

    iRows = 2

    Dim MyRange As Range

    Dim cell As Range

    Dim Wb As Workbook

    Dim FiltRange As Range

   

     Workbooks("RIRQ and RRTNs with LOB Sept 28 2020").Activate

    'Set MyRange = Workbooks("RIRQ and RRTNs with LOB Sept 28 2020").Worksheets("Data").Range(Cells(1, 1).Offset(1, 0), Range("A1").End(xlDown))
    
    
    ' select the records in column A
    Set MyRange = Workbooks("RIRQ and RRTNs with LOB Sept 28 2020").Worksheets("Data").Range(Cells(2, 1), Range("A1").End(xlDown))

        'Debug.Print MyRange.Address
    'only select the filtered records
    Set FiltRange = MyRange.SpecialCells(xlCellTypeVisible)

    'Debug.Print FiltRange.Address

   

    
    'create a filter for emails marked as not completed
    sFilter = "[Categories] = 'Not Completed'"

    'Debug.Print sFilter

    ThisWorkbook.Sheets("Sent_Email").Activate

    ' Loop through each item in the folder.

    'Debug.Print myFolder.Items.Restrict(sFilter).Count
    
    'loop through the emails in the sent folder restricted to specific category
    For Each objItem In myFolder.Items.Restrict(sFilter)

        If objItem.Class = olMail Then

       

            Dim objMail As Outlook.MailItem

            Set objMail = objItem

 
            'extract data from email
            Cells(iRows, 1) = objMail.Recipients(1)

            Cells(iRows, 2) = objMail.To

            Cells(iRows, 3) = objMail.Subject

            Cells(iRows, 4) = objMail.ReceivedTime

            Cells(iRows, 5) = objMail.Body

            'If MyRange <> "" Then
                
                'loop throug the records on the spreadsheet to find matches
                For Each cell In FiltRange

                    'Debug.Print MyRange.Find(cell.Value)

                'Debug.Print cell.Value

                'Debug.Print Cells(iRows, 5)

                    'if the email body contain the matching record or specific string then copy the received time to the row for the matching record

                    If InStr(LCase(Cells(iRows, 5)), cell.Value > 0) And InStr(LCase(Cells(iRows, 5)), LCase("GTPRM")) > 0 Then

                        

                        Debug.Print cell.Value

                        cell(, 35).Value = Cells(iRows, 4).Value

                    End If

                Next cell

               

            'End If

           

        End If

        iRows = iRows + 1

    Next

    Set objMail = Nothing

  

    ' Release.

    Set objOutlook = Nothing

    Set objNSpace = Nothing

   Set myFolder = Nothing

ErrHandler:

    Debug.Print Err.Description

End Sub