Question

Issue: I’m having to search a large sheet for specific policy numbers. The find function takes quite a while when there are nearly 75,000 rows. Any suggestions on how to compare these two sheets of 75,000 rows? A solution i thought might work would be to sort each sheet and then take the policy number needed to be found and compare it to the middle row. Is there a way to compare that policy number and see if in the simple sort function it would be greater or less than? After finding that comparison, i would reset the upper and lower bounds and find the middle again. …Would this be quicker? Are there any other suggestions?

Thank you

Current Code:

Sub policyComment()

Dim x As Integer
Dim endRow As Variant
Dim polSer As String
Dim foundVal As String
Dim commentVar As Variant        

Windows("SuspenseNoteMacro.xlsm").Activate
Sheets("Main").Select

Range("A2").Select
endRow = ActiveCell.End(xlDown)

x = 2

Do
    polSer = Range("A" + CStr(x)).Value

    Windows("010713 Suspense ALL.xlsm").Activate
    Sheets("Sheet1").Select

    Set foundRange = Sheets("Sheet1").Cells.Find(what:=polSer, LookIn:=xlFormulas, lookat:=xlWhole)

   'foundRange = ActiveCell.Value     
    If foundRange Is Nothing Then
        Windows("SuspenseNoteMacro.xlsm").Activate
        Sheets("Main").Select
        Range("J" + CStr(x)).Value = "Not Found"
    ElseIf foundRange <> "" Then
        Sheets("Sheet1").Cells.Find(what:=polSer, LookIn:=xlFormulas, lookat:=xlWhole).Activate
        commentVar = Range("J" + CStr(ActiveCell.Row)).Value
        Windows("SuspenseNoteMacro.xlsm").Activate
        Sheets("Main").Select
        Range("J" + CStr(x)).Value = commentVar
    End If

    x = x + 1
    Range("A" + CStr(x)).Select
    foundRange = ""
Loop Until (x = endRow)

End Sub

Answer 1

Your code is slow for a few reasons, but mainly because of how you are looping through each cell individually (the actual Find function is not what is slowing it down).

Below, I’ve put your search column into an array and looped through that, which will be much, much faster. I’ve also taken out all your select and activate statements, as they are extraneous 99% of the time in VBA, and can also slow down your code a bit. Lastly, I turned off ScreenUpdating which helps as well.

If I missed something in the refactoring, let me know.

Option Explicit

Sub policyComment()

Dim x As Long, endRow As Long, polSer As String, foundRange As range, commentVar As String
Dim varArr() As Variant
Dim wksMain As Worksheet, wks1 As Worksheet

Set wksMain = Sheets("Main")
Set wks1 = Sheets("Sheet1")

Application.ScreenUpdating = False

With wksMain

    endRow = .range("A" & .Rows.Count).End(xlUp).Row
    varArr = .range("A2:A" & endRow)

    For x = LBound(varArr) To UBound(varArr)

        polSer = varArr(x, 1)

        With wks1

            Set foundRange = .Cells.Find(polSer, LookIn:=xlFormulas, lookat:=xlWhole)

            If foundRange Is Nothing Then

                wksMain.range("J" & x + 1).Value = "Not Found" 'need to add 1 to x because arrays are zero based

            Else

                commentVar = .range("J" & foundRange.Row)
                wksMain.range("J" & x + 1).Value = commentVar ''need to add 1 to x because arrays are zero based

            End If

        End With

    Next

End With

Application.ScreenUpdating = True

End Sub