Excel FIND function

[TheBionicOrange]

Could anyone possibly suggest an alternative for the code below.
The reason I ask is that it is very slow, as it works on a line-by-line basis, and has to cover 12000+ lines.

What I am doing is looking for an occurence of a particular word/words, and then colouring in the line that the word sits on. As the data is variable in size then these lines are never in the same place twice.

I know its quite a big ask, but any help much appreciated.

        ' Colour the SBC Total Lines
        .Range("A1").Select
        IntY = 1
        IntX = 0
        With .ActiveSheet
                .Cells.Find(What:="SBC", After:=objExcel.ActiveCell, LookIn:=objExcel.XlFindLookIn.xlFormulas, LookAt _
                    :=objExcel.XlLookAt.xlPart, SearchOrder:=objExcel.XlSearchOrder.xlByRows, SearchDirection:=objExcel.XlSearchDirection.xlNext, MatchCase:= _
                    False).Activate
            Do Until IntX >= IntY
                IntX = objExcel.ActiveCell.Row
                objExcel.Selection.EntireRow.Font.Bold = True
                objExcel.Selection.EntireRow.Font.ColorIndex = 10
                objExcel.Cells.FindNext(After:=objExcel.ActiveCell).Activate
                IntY = objExcel.ActiveCell.Row
            Loop
        
        End With
        
        ' Colour the CAT Total Lines
        .Range("A1").Select
        IntY = 1
        IntX = 0
        With .ActiveSheet
                .Cells.Find(What:="CAT", After:=objExcel.ActiveCell, LookIn:=objExcel.XlFindLookIn.xlFormulas, LookAt _
                    :=objExcel.XlLookAt.xlPart, SearchOrder:=objExcel.XlSearchOrder.xlByRows, SearchDirection:=objExcel.XlSearchDirection.xlNext, MatchCase:= _
                    False).Activate
            Do Until IntX >= IntY
                IntX = objExcel.ActiveCell.Row
                objExcel.Selection.EntireRow.Font.Bold = True
                objExcel.Selection.EntireRow.Font.ColorIndex = 5
                objExcel.Cells.FindNext(After:=objExcel.ActiveCell).Activate
                IntY = objExcel.ActiveCell.Row
            Loop
        
        End With
        
        ' Colour the BAS Total Lines
        .Range("A1").Select
        IntY = 1
        IntX = 0
        With .ActiveSheet
                .Cells.Find(What:="Total for", After:=objExcel.ActiveCell, LookIn:=objExcel.XlFindLookIn.xlFormulas, LookAt _
                    :=objExcel.XlLookAt.xlPart, SearchOrder:=objExcel.XlSearchOrder.xlByRows, SearchDirection:=objExcel.XlSearchDirection.xlNext, MatchCase:= _
                    False).Activate
            Do Until IntX >= IntY
                IntX = objExcel.ActiveCell.Row
                objExcel.Selection.EntireRow.Font.Bold = True
                objExcel.Selection.EntireRow.Font.ColorIndex = 46
                objExcel.Cells.FindNext(After:=objExcel.ActiveCell).Activate
                IntY = objExcel.ActiveCell.Row
            Loop
        
        End With

Thanks a lot.