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.

[Hack]

Moved to Office Development

[Mitch_s_s]

is the data sorted alphabetically?
how many times will the phrase appear?

also, remove all the .select statements from your code

also set
application.screenupdating = false
at the start of your code

[Mitch_s_s]

Sub colour_test()
 
Dim cell As Range
Application.ScreenUpdating = False
For Each cell In Range("A1:A260")
 
Select Case cell.Value
    Case "abc"
        cell.Interior.ColorIndex = 34
    Case "def"
        cell.Interior.ColorIndex = 35
    Case "ghi"
        cell.Interior.ColorIndex = 36
End Select
 
 
Next cell
 
Application.ScreenUpdating = True
 
End Sub

[Mitch_s_s]

just run that code for cells A1:A36271
it started 31/05/2007 20:09:03
it finished 31/05/2007 20:09:06

[TheBionicOrange]

Thanks for replying Mitch. I tried your code out, but it doesn't seem to haev made it any faster unfortunately. I know the max number of rows is going to 5000, so based on that I have the following ...

        .Application.ScreenUpdating = False
        
        For Each Cell In objExcel.Range("A10:Z5000")
            Select Case Cell.Value
                Case "SBC"
                    Cell.EntireRow.Interior.ColorIndex = 10
                Case "CAT"
                    Cell.EntireRow.Interior.ColorIndex = 5
                Case "Total for"
                    Cell.EntireRow.Interior.ColorIndex = 46
            End Select
        Next Cell

For the record, no I'm not sorting my data alphabetically.
Also, depending on the data, it will depend how many occurences there are of each bit of text I am looking for.

[Mitch_s_s]

start and end times for me running that code

01/06/2007 14:34:46
01/06/2007 14:34:48


can you upload your workbook, for me to look at?

[TheBionicOrange]

I think I might be in trouble if I did. There is an awful lot of confidential info in it. I notice your code works on one column, whereas mine works on 26, and also I am trying to colour the entire line rather than just the "found" cell.
I realise this would have an impact on speed ... I'm just a bit surprised its this much.

[TheBionicOrange]

Bear in mind this code IS super quick if there are next to no occurences, but in my workbook there are plenty.

[Mitch_s_s]

do these phrases appear in different colums?
what is the range you are searching?

i ran the code you posted, and it took 2 seconds to completion

[TheBionicOrange]

Yeah it would be 2 seconds for me too, on a worksheet that doesn't contain the phrases, or had hardly any occurences of them.
You have raised a point though. The occurences ARE in the same column, and yet I am opening it up to 26 columns where I needn't. Hmmmm .. lets try that again !

[Mitch_s_s]

i repeated the phrase every 3 lines
so it was
SBC
CAT
Total for

repeated for every cell in the range A1:A5000

the code above still took 2 seconds

[si_the_geek]

I can make this much faster with a few of my tricks... to get the best possible improvement tho, which column(s) can contain the values?

[si_the_geek]

Assuming that you want to check all cells (it would be faster & use less memory with a smaller range), this should do it:

Dim vArray As Variant
  vArray = activesheet.UsedRange.Value

Dim lngCol As Long, lngRow As Long
  For lngRow = 1 To UBound(vArray, 1)
    For lngCol = 1 To UBound(vArray, 2)
      Select Case vArray(lngRow, lngCol)
      Case "SBC"
        activesheet.rows(lngRow).EntireRow.Interior.ColorIndex = 10
        Exit For
      Case "CAT"
        activesheet.rows(lngRow).EntireRow.Interior.ColorIndex = 5
        Exit For
      Case "Total for"
        activesheet.rows(lngRow).EntireRow.Interior.ColorIndex = 46
        Exit For
      End Select
    Next lngCol
  Next lngRow
  Erase vArray

..note that it stops checking a row when it finds the first occurence of any of the items - so you may want to re-organise a bit to prioritise which colouring takes place if there are multiple values found.


Also, if you haven't done it already, set Application.ScreenUpdating to False while the code is running (and set it back to True after).

[TheBionicOrange]

Mitch you were right, once I limited my range to just the one column it WAS a lot quicker. There are occurences of the text I need all over the place, but lucky for me they all start in the same column.

Si .... I will try out what you posted and let you guys know which I found quickest. Either way, both are already a lot better than what I had.

Watch this space ...

[TheBionicOrange]

I can make this much faster with a few of my tricks... to get the best possible improvement tho, which column(s) can contain the values?

All values ONLY exist in the first column.

Now trying out your code ...

[si_the_geek]

In that case you can simplify my code a bit.. here's an updated version:

Dim vArray As Variant
     'only retrieve data for the first column
  vArray = activesheet.Range("A1:" & activesheet.UsedRange.rows.count).Value

Dim lngRow As Long
  For lngRow = 1 To UBound(vArray, 1)
       'no need to loop thru the columns now
    Select Case vArray(lngRow, 1)
    Case "SBC"
      activesheet.rows(lngRow).EntireRow.Interior.ColorIndex = 10
    Case "CAT"
      activesheet.rows(lngRow).EntireRow.Interior.ColorIndex = 5
    Case "Total for"
      activesheet.rows(lngRow).EntireRow.Interior.ColorIndex = 46
    End Select
  Next lngRow
  Erase vArray

[TheBionicOrange]

Yeah I did that.

Net result .... 5 seconds.
The idea Mitch came up with took about 12, which was WAY better than what I had, but now I have halved that again then this is the one I will use.

Thank you both for your help. Its much appreciated and I now have a few more snippets of code to squirrel away

You guys have saved me a LOT of time .... thank you !

[Mitch_s_s]

nice that si you geek

[numtel]

I would think that if you set Application.ScreenUpdating while it was running to false, then reset after completed, it would speed things up a lot as well.

[TheBionicOrange]

Scroll up ... thats already been mentioned.