Search routine in Excel ...

I currently have the following code which reads thru about 10,000 rows and colours in total lines.
The data has been exported form a flexgrid.

What I would like to know is if either a quicker way to achieve my goal or whether the below code could be tweaked.
It all works fine, I'm just trying to speed it up a bit if I possibly can.

Code:

---

        ' Format Total Lines
        For i = 1 To 5
            LastOne = False
            Select Case i
                Case 1  ' Line
                    display_status "Formatting Line Totals in Excel ..."
                    SearchItem = "^"
                    SearchItem1 = "^ ^"
                    Forecolour = 10
                    BackColour = 36
                Case 2  ' Season
                    display_status "Formatting Season Totals in Excel ..."
                    SearchItem = ">"
                    SearchItem1 = "> >"
                    Forecolour = 53
                    BackColour = 45
                Case 3  ' Sub-Category
                    display_status "Formatting Sub-Category Totals in Excel ..."
                    SearchItem = "!"
                    SearchItem1 = "! !"
                    Forecolour = 41
                    BackColour = 34
                Case 4  ' Category
                    display_status "Formatting Category Totals in Excel ..."
                    SearchItem = "<"
                    SearchItem1 = "< <"
                    Forecolour = 10
                    BackColour = 35
                Case 5  ' Department
                    display_status "Formatting Department Totals in Excel ..."
                    SearchItem = "{"
                    SearchItem1 = "{ {"
                    Forecolour = 2
                    BackColour = 39
            End Select
       
            On Error Resume Next
            'On Error GoTo CarryOn
            IntX = 0
            IntY = 1
            .Range("A1").Select
            With objExcel
                ' Boldface the Total Lines
                .ActiveSheet.Cells.Find(What:=SearchItem, After:=objExcel.ActiveCell, LookIn:=xlValues, LookAt _
                    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                    False).Activate
                Do Until IntX >= IntY
                    IntX = objExcel.ActiveCell.Row
                   
                    If objExcel.ActiveCell.Value = SearchItem1 Then LastOne = True
                   
                    objExcel.ActiveCell.Value = ""
                    objExcel.Selection.EntireRow.Font.Bold = True
                   
                    objExcel.Range(objExcel.ActiveCell.Offset(0, -24), objExcel.ActiveCell.Offset(0, -1)).Interior.ColorIndex = BackColour
                    objExcel.Selection.EntireRow.Font.ColorIndex = Forecolour
                   
                    If LastOne Then GoTo CarryOn
                   
                    objExcel.Cells.FindNext(After:=objExcel.ActiveCell).Activate
                    IntY = objExcel.ActiveCell.Row
                Loop
CarryOn:
            End With
        Next i

---

Any sensible input much appreciated ...