Updating Macro to use .Find & .FindNext

[PeterJohns]

the macro below has been fine for the sreadsheets i have been working circa 20K -30k rows. however now having to work on spreadsheets that are sometimes in excess of 100k. the time in takes to traverse the spreadsheet is in hours rather than minutes. Is there a way of speeding it up?

The macro checks, if the category is right in this case 100, then sees if there is a match between column 11 and column1 and then highlights both.

Private Sub CommandButton2_Click()

Dim xcnt, iUse, iRes As Long
Dim bEnd As Boolean
Worksheets("assetchains").Cells(3, 4).Value = "Working"
bEnd = True
xcnt = 4
'find first clear row
While (bEnd)
If Worksheets("assetchains").Cells(xcnt, 1).Value <> "" Then xcnt = xcnt + 1 Else bEnd = False
iRes = 0
If Worksheets("assetchains").Cells(xcnt, 4).Value = "100" Then iRes = findchild(Worksheets("assetchains").Cells(xcnt, 1).Value)
If iRes = 1 Then Worksheets("assetchains").Cells(xcnt, 1).Interior.ColorIndex = 6
Worksheets("assetchains").Cells(1, 11).Value = xcnt
Wend
Worksheets("assetchains").Cells(3, 4).Value = "Finished"

End Sub
Function findchild(srchtxt)
Dim iRes, iRes2 As Long
Dim counter6 As Long
Dim bchk As Boolean
bchk = True
iRes = 0
iRes2 = 0
counter6 = 4
While (bchk)
iRes = 0
If Worksheets("assetchains").Cells(counter6, 10).Value = srchtxt Then iRes = 1
If iRes = 1 Then iRes2 = iRes2 + 1
If iRes = 1 Then Worksheets("assetchains").Cells(counter6, 10).Interior.ColorIndex = 6
counter6 = counter6 + 1
If Worksheets("assetchains").Cells(counter6, 1).Value = "" Then bchk = False
Wend
If (iRes2) Then findchild = 1 Else findchild = 0
End Function

[nathansav]

you could do a countif before hand to see if there are any 100's there?

Please Login or Register  to view this content.