Sheet not being attached in Outlook

I have a sheet called "BTR Intercompany" .In Col A , I have several text items which includes text "Variance". Where there is a value in Col D in same row as "Variance" in Col A that is not zero or absolute value >=0.01, then attach sheet. My Code below only attaches the sheet if the first value in Col D in same row as variance in Col A <> 0 and ABS >=0.01. If the first Value is zero in Col D in same row as "Variance" in Col A , but other values in Col D <> zero or ABS >=0.01 where there is "Variance" in Col A in same row , then sheet is not being attached


Kindly test & amend my code

Sub Email_BTR_Intercompany()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("BTR Intercompany")
    
    Dim varCell As Range
    Dim attachSheet As Boolean
    attachSheet = False
    
    For Each varCell In ws.Range("A:A").Find("Variance", LookIn:=xlValues, LookAt:=xlWhole)
        If Abs(varCell.Offset(0, 3).Value) >= 0.01 Then
            attachSheet = True
            Exit For
        End If
    Next varCell
    
    If Not attachSheet Then
        Exit Sub
    End If
    
    Dim rng As Range
    Dim isFirstVariance As Boolean
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Stringbody As String
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    ' Copy the ActiveSheet to a new workbook
    ws.Copy
    Set Destwb = ActiveWorkbook
    
    ' Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            ' You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            ' You use Excel 2007-2013
            Select Case Sourcewb.FileFormat
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If .HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If
    End With
    
    ' Change all cells in the worksheet to values if you want
    With Destwb.Sheets(1).UsedRange
        .Value = .Value
    End With
    
    Application.CutCopyMode = False
    
    ' Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = ws.Range("A2") & " Intercompany Variance " & Format(Now, "dd-mmm-yy h-mm-ss")
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = ws.Range("L1:L1")
            .CC = ""
            .BCC = ""
            .Subject = "Variance Report: " & ws.Range("A2") & " Intercompany"
            Stringbody = "Hi " & ws.Range("K1").Value & vbNewLine & vbNewLine
            Stringbody = Stringbody & "Attached, please find the Intercompany Variance report for " & ws.Range("A2") & "." & vbNewLine & vbNewLine
            Stringbody = Stringbody & "Please advise once corrected." & vbNewLine & vbNewLine
            Stringbody = Stringbody & "Regards" & vbNewLine & vbNewLine
            Stringbody = Stringbody & "Howard" ' Replace with your name or signature

            .Body = Stringbody
            .Attachments.Add Destwb.FullName
            .Display ' Use .Send to send automatically or .Display to check email before sending
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    ' Delete the file you have sent (optional)
    ' Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

End Sub

For Each varCell In ws.Range("A:A").Find("Variance", LookIn:=xlValues, LookAt:=xlWhole)
        If Abs(varCell.Offset(0, 3).Value) >= 0.01 Then
            attachSheet = True    
            Exit For
        End If
    Next varCell
    
    If Not attachSheet Then
        Exit Sub
    End If

change to

For Each varCell In ws.Range("A:A").Find("Variance", LookIn:=xlValues, LookAt:=xlWhole)
        If Abs(varCell.Offset(0, 3).Value) >= 0.01 Then
                
            **** Add your main code here as you only loop through this once with your current code ******
End If
    Next varCell
    
    If Not attachSheet Then  **** REDUNDANT
        Exit Sub
    End If