VBA executes slowly if there are blank cells

I have the following macro in Excel VBA, and it works as I want. (Compares text in Column A of the Entry sheet, with Column A of the Clauses sheet, and highlights matching cells) But if there are any blank cells in column A of the Entry sheet, it runs very slow. It doesn't seem to matter if there are empty cells in the Clauses sheet. Any ideas how to make it so it doesn't take so long if someone leaves a cell blank?

Dim c As Range, fn As Range, adr As String
    With Sheets("sheet1")
        For Each c In .Range("A1", .Cells(Rows.Count, 1).End(xlUp))
            Set fn = Sheets("Clauses").Range("A:A").Find(c.Value, , xlValues, xlWhole)
                If Not fn Is Nothing Then
                    adr = fn.Address
                    c.Interior.Color = RGB(255, 100, 50)
                    Do
                        fn.Interior.Color = RGB(255, 100, 50)
                        Set fn = Sheets("Clauses").Range("A:A").FindNext(fn)
                    Loop While fn.Address <> adr
                End If
        Next
    End With

I have tried using If Not c Is Nothing Then and <>"". I'm just not sure if I am using them correctly?

Solution

Highlight Matches in the Source and Destination

Never search for a value in a whole worksheet column.
You could use .End(xlUp) for both columns (adjust the first cells).

Sub HighlightMatches()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' The Find method or the End property will fail if the worksheet is filtered.
    
    Dim sws As Worksheet: Set sws = wb.Sheets("Sheet1")
    'If sws.FilterMode Then sws.ShowAllData
    Dim srg As Range:
    Set srg = sws.Range("A2", sws.Cells(sws.Rows.Count, "A").End(xlUp))
    
    Dim dws As Worksheet: Set dws = wb.Sheets("Clauses")
    'If dws.FilterMode Then dws.ShowAllData
    Dim drg As Range:
    Set drg = dws.Range("A2", dws.Cells(dws.Rows.Count, "A").End(xlUp))
    
    Dim surg As Range, sCell As Range, sValue
    Dim durg As Range, dCell As Range, dAddress As String
    
    For Each sCell In srg.Cells
        sValue = sCell.Value
        If Len(CStr(sValue)) > 0 Then ' is not blank
            Set dCell = drg.Find(sValue, , xlValues, xlWhole)
            If Not dCell Is Nothing Then
                dAddress = dCell.Address
                Set surg = RefCombinedRange(surg, sCell)
                Do
                    Set durg = RefCombinedRange(durg, dCell)
                    Set dCell = drg.FindNext(dCell)
                Loop While dCell.Address <> dAddress
            End If
        End If
    Next sCell

    ' Clear and highlight in (almost) one go!

    If Not surg Is Nothing Then
        ClearAndHighlight srg, surg, RGB(255, 100, 50)
    End If
    
    If Not durg Is Nothing Then
        ClearAndHighlight drg, durg, RGB(255, 100, 50)
    End If

End Sub

Combine Ranges

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      References a range combined from two ranges.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefCombinedRange( _
    ByVal urg As Range, _
    ByVal arg As Range) _
As Range
    If urg Is Nothing Then Set urg = arg Else Set urg = Union(urg, arg)
    Set RefCombinedRange = urg
End Function

Clear and Highlight

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Clears the fill color of a range, and applies
'               a given fill color to another range.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ClearAndHighlight( _
        ByVal ClearRange As Range, _
        ByVal HighlightRange As Range, _
        ByVal HighlightColor As Long)
     ClearRange.Interior.ColorIndex = xlNone
     HighlightRange.Interior.Color = HighlightColor
End Sub