Speed up camparing two workbooks VBA

[Helidragon]

Help Please, this code is taking to long to complete. I believe because of the two Loops, each loop contains 100 cells so it is looping through 10000 cells and taking about 6 mins to complete. My guess is there is another way to do this and not take so long. Any help would be appreciated.

Private Sub CommandButton1_Click()
Dim c, c2, SN, FLexBn, FlexNN As Range
Dim Flex As Workbook
Dim wks As Worksheets


Set SN = Worksheets((MonthName(Month(Range("Date")))))
Set RngAN = SN.Range("DLCAN11")
Set AN = Range("1:24").Find("Acct. No.", , , xlWhole, , , False, , False)
Set Flex = Workbooks.Open("c:\Flex 123\Monitored Line (Flex 123) Report.xlsx")
Set RLC = ThisWorkbook

    For Each c In RngAN
         If c.Value <> "" And c.Value <> "Days Past Due" Then
            With Flex
                For Each c2 In Worksheets("page1").Range("c4:c100")
                    If c2.Value = c.Value Then
                        c2.Interior.ColorIndex = 38
                    End If
                Next c2
        
            End With
         End If
    Next
 
    For Each c2 In Flex.Worksheets("page1").Range("c4:c100")
        With Flex
            For Each c In RngAN
                If c.Value = c2.Value And c.Value <> "Days Past Due" Then
                    If c.Offset(0, -1).Value <> c2.Offset(0, 1).Value Then
                       c.Offset(0, -1).Interior.ColorIndex = 38
                       c.Offset(0, -1).Value = c2.Offset(0, 1).Value
                    End If
                    If c.Offset(0, 2).Value <> c2.Offset(0, 5).Value Then
                       c.Offset(0, 2).Interior.ColorIndex = 38
                       c.Offset(0, 2).Value = c2.Offset(0, 5).Value
                    End If
                    If c.Offset(0, 8).Value <> c2.Offset(0, 6).Value Then
                       c.Offset(0, 8).Interior.ColorIndex = 38
                       c.Offset(0, 8).Value = c2.Offset(0, 6).Value
                    End If
                    If c.Offset(0, 7).Value <> c2.Offset(0, 7).Value Then
                       c.Offset(0, 7).Interior.ColorIndex = 38
                       c.Offset(0, 7).Value = c2.Offset(0, 7).Value
                    End If
                    If c.Offset(0, 6).Value <> c2.Offset(0, 8).Value Then
                       c.Offset(0, 6).Interior.ColorIndex = 38
                       c.Offset(0, 6).Value = c2.Offset(0, 8).Value
                    End If

                End If

            Next c
    
        End With
    Next
 
 End Sub

 

[JoeMo]

Consider adding two blocks to your code:

First, right after the Dim statements:

With Application
    .EnableEvents = false
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With

Then, just before the End Sub line:

With Application
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With

 

[Helidragon]

Thank you Joe, added these and I understand what they do but did nothing to speed up the loops. Maybe I don’t need the loops just not sure of other possibilities.

 

[My Aswer Is This]

To make it easier for me so I do not have to figure out what this script is trying to do.

Would you please explain in words what your wanting to do.

 

[Helidragon]

I am matching loan numbers on one workbook and finding that same loan number on another workbook. if there are any changes in that row I want it to high light the cell and change the data on the first workbook. If there is a loan number that doesn’t exist in either workbook I need it to highlight the row. The work books do not have matching columns. Hope that helps a little. Sorry don’t know how to put the code in the pretty box and make it more legible.

 

[offthelip]

One of the main reasons that Vba is slow is the time taken to access the worksheet from VBa is a relatively long time.
To speed up vba the easiest way is to minimise the number of accesses to the worksheet. What is interesting is that the time taken to access a single cell on the worksheet in vba is almost identical as the time taken to access a large range if it is done in one action.
So instead of writing double loop which loops down the range accessing a cell at a time which will take along time if you have got 1000 cells it is much quicker to load both ranges into a variant arrays ( two worksheet access), then loop through the Variant arrays to do all the testing. Unfortunatelly because you want to format the cells when you find the match you do need to access the worksheet to do that
I had a look at your code but you do so many acceses to the workhseet it is going to be quite a rewrite.
So here is an example of how to rewrite a bit of your code:
orginal:

                 For Each c2 In Worksheets("page1").Range("c4:c100")                   
                    If c2.Value = c.Value Then
                        c2.Interior.ColorIndex = 38
                    End If
                Next c2

rewritten using one variant array

 inarr = Worksheets("page1").Range("c4:c100")
                 For i = LBound(inarr) To UBound(inarr)
                    If inarr(i, 1) = c.Value Then
                       Worksheets("page1").Range(Cells(i, 3), Cells(i, 3)).Interior.ColorIndex = 38
                    End If
                Next

note you need to do more changes to get rid of the C.value in this bit of code
I have a simple rule for fast VBA: NEVER ACCESS THE WORKSHEET IN A LOOP.

 

[Norie]

Instead of looping with not use Find or Application.Match to locate the loan numbers from one workbook in the other workbook?

 

[Helidragon]

Let me see if I can figure this out. If I eliminate the color and create a msgbox with the details does that remove the access?

Thank you

 

[offthelip]

the best way of doing it is to write all the matches to another "output" variant array and then write this back to the workhseet in one go. as an example this routine will pick columnn A and B from sheet2 and then find the matching values in both column A and copy the values from Sheet2 column B to sheet 1 column J

Sub test()
With Worksheets("Sheet2")
datar = Range(.Cells(1, 1), .Cells(20, 2))
End With
With Worksheets("Sheet1")
inarr = .Range(.Cells(1, 1), .Cells(20, 1))
outarr = .Range(.Cells(1, 10), .Cells(20, 10))
For i = 1 To 20
  outarr(i, 1) = ""
  For j = 1 To 20
 If datar(j, 1) = inarr(i, 1) Then
  outarr(i, 1) = datar(j, 2)
  Exit For
 End If
 Next j
Next i
 .Range(.Cells(1, 10), .Cells(20, 10)) = outarr
 
End With
 
End Sub

This code works just like a VLOOKUP,
however you can write what ever like into the output,
ie. if you change the statement to :

outarr(i, 1) = j

this will tell you which row it matches on the sheet2. iei like a Match function
or if you just want a colour

outarr(i, 1) = "Red"

Ok it won't look red it just has the text "Red " in it, but you see what I mean

 

[Norie]

One of the main reasons any code is slow is due to excessive looping.

If you tried my suggestion you might be able to cut down the looping.