You can also try this:-

Code:
Option Explicit


 Sub lm()
 
    Dim rngRange            As Range
    Dim rngFirstRange       As Range
    Dim rngToFind           As Range
    
    Const strStringToFind   As String = "a"
    
    With ThisWorkbook.Worksheets("Sheet1")
        Set rngToFind = .Range("A1").CurrentRegion
        With rngToFind
            Set rngRange = .Find(strStringToFind, LookIn:=xlValues, lookat:=xlWhole)
            If Not rngRange Is Nothing Then
                Set rngFirstRange = rngRange
                Do
                    rngRange.Interior.ColorIndex = 3
                    Set rngRange = .FindNext(rngRange)
                Loop While Not rngRange Is Nothing And rngRange.Address <> rngFirstRange.Address
            End If
        End With
    End With
    
    Set rngRange = Nothing
    Set rngFirstRange = Nothing
    Set rngToFind = Nothing
 
 End Sub