range.findall is very slow.any alternatives

Question

Here is what i am doing with huge data in sheet 1 and sheet 2:

compare sheet1.columnnames (based on multiple comparisons) to all the matching rows in sheet2. Highlight differences and paste it to result sheet.
In the result sheet, for all rows which have same value in column1 , check the font color for other fields. if it is red, copy column1 to new result sheet.

I am done with (1). For (2) I am using findall function for range from (http://www.cpearson.com/excel/findall.aspx) to get subset of all duplicates in column1. The code is working but it is very very slow. Is there any other way i can do it?

I could have done it using arrays but i am not able to touch font colors using arrays. I tried Application.Calculation = xlCalculationManual and Application.ScreenUpdating = False. It did not make any difference.

Following is the code snippet for find all. Can you please suggest any other method?

    Dim foundRange As Range
Dim SearchRange As Range
Dim FindWhat As Variant
Dim irowcount, icount, iMaxCount As Long
Dim bFlag As Boolean
With XL_Ws_Result
    'range with column header
    Set rowRangeHeaderA = .Range(.Cells(1, 1), .Cells(Last_Row_Base, Last_Col_Base))
    'range in result sheet without column header
    Set SearchRange = rowRangeHeaderA.Offset(1, 0).Resize(rowRangeHeaderA.Rows.count - 1, Last_Col_Base)
End With

For irowcount = 1 To SearchRange.Rows.count
    'search string
    FindWhat = SearchRange.Cells(irowcount, 1)

    Set foundRange = FindAll(SearchRange:=SearchRange, _
                            FindWhat:=FindWhat, _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByColumns, _
                            MatchCase:=False, _
                            BeginsWith:=vbNullString, _
                            EndsWith:=vbNullString, _
                            BeginEndCompare:=vbTextCompare)

    If Not foundRange Is Nothing Then
        iMaxCount = foundRange.Rows.count
        For icount = 1 To iMaxCount
            'check font color
            If foundRange.Cells(icount, 9).Font.ColorIndex = 3 And foundRange.Cells(icount, 9).Font.ColorIndex = 3 Then
                bFlag = True
            Else
                'if any cell is not red i want to skip entire found range. not need for further processing
                bFlag = False
                Set foundRange = Nothing
                Exit For
            End If

            If bFlag = True Then
                XL_Mismatch.Cells(i, 1) = foundRange.Cells(1, 1).Value
            End If
        Next icount

        irowcount = irowcount + iMaxCount - 1
    End If
Next irowcount

JiheL JiheL · Accepted Answer · 2017-02-15T16:02:29

"for all rows which have same value in column1" -> this means you HAVE to make an .Autofilter (much faster than .Find)

"check the font color for other fields. if it is red, copy column1 to new result sheet" -> then you loop through the filtered cells as you did OR before or after the previous .Autofilter, you add a column (with let's say 0 or 1) and loop through the cells to get the font color as you want and then .Autofilter again with 2 conditions this time (value + 0 or 1).

After that, feel free to copy the filtered range and paste it to the new result sheet.

I think this should be faster.

range.findall is very slow.any alternatives

2 Answers