Help Reduce Macro Time For 20,000 rows Takes 1 hr and 23min!

[matt9man]

Background:
So I have 20 procedure macro that does the following operations:
Clears cells from sheets, open inputs files, copys input data, creates keys by using logical keys for expected and actual, compares expected and actual results by doing vlookup off of expected key - highlights wrong cells, highlights red duplicates of actual and expected in there sheets, and then lastly finds extra actuals that are not in expected sheet and copys that key in underneath all comparisons.

Problem: Orginally it took 2.5 hours for the Macro to compare 20,000 rows from two input files.

Now it takes 1h20min by adding manual calculation syntax and cancel screen updating.

What else can I do to reduce the time to complete 20,000 rows from 1h20min to 20 - 30 min?

Thanks(Let me know if you need code theres like 30 pages)

 

[matt9man]

I have found the procedures that are causing the bottleneck anyway I can speed this up keep in mind the vlookup value may in some cases have .//. in it so 'find' would not work. Below in my quote is the where the bottleneck is occuring. Please help. Thank you.

I also have noticed in the below three procedures it takes the most time because its populating actual and expected then comparing any recommendation on how to speed this up? Thanks a lot.

Sub PopulateExp()
Dim xlCalc As XlCalculation
    xlCalc = Application.Calculation
    Application.Calculation = xlCalculationManual
    On Error GoTo CalcBack
'Takes expected data populates it every other row until all expected are shown in the Compare Result Sheet
 
Dim intExpRow As Long
Dim intCompRow As Long
Dim intCol As Long
intExpRow = 3
intCompRow = 3
intCol = 1
Sheet3.Select
intRowCnt = Sheet4.Cells(1, 2)
Call ClearAllComp
While Sheet2.Cells(intExpRow, intCol) <> ""
   Sheet3.Cells(intCompRow, intCol) = "Expected"
   Sheet3.Cells(intCompRow, intCol + 1) = Sheet2.Cells(intExpRow, intCol + 1)
   Sheet3.Cells(intCompRow, intCol + 2) = Sheet2.Cells(intExpRow, intCol + 2)
   Sheet3.Cells(intCompRow, intCol + 3) = Sheet2.Cells(intExpRow, intCol)
 
   While (intCol <= intRowCnt)
   Sheet3.Cells(intCompRow, intCol + 4) = Sheet2.Cells(intExpRow, intCol + 3).Value
   intCol = intCol + 1
   Wend
 
   Sheet3.Rows(intCompRow).Select
 
    With Selection.Interior
        .ColorIndex = 34
        .Pattern = xlSolid
    End With
 
   Call PopulateAct(intCompRow)
 
   intCompRow = intCompRow + 2
   intExpRow = intExpRow + 1
 
 
intCol = 1
Wend
Application.Calculation = xlCalc
 
    Exit Sub
CalcBack:
Application.Calculation = xlCal
End Sub
 
Sub PopulateAct(intCompRow)
Dim xlCalc As XlCalculation
    xlCalc = Application.Calculation
    Application.Calculation = xlCalculationManual
    On Error GoTo CalcBack
'Takes actual data populates below the expected result by using the key and the vlookup value in expected range
Dim intExpRow As Long
Dim intCol As Long
intCol = 1
Sheet3.Select
   Sheet3.Cells(intCompRow + 1, intCol) = "Actual"
   Sheet3.Cells(intCompRow + 1, intCol + 1) = Sheet3.Cells(intCompRow, intCol + 1)
   Sheet3.Cells(intCompRow + 1, intCol + 2) = Sheet3.Cells(intCompRow, intCol + 2)
 
   While (intCol <= intRowCnt + 1)
   Sheet3.Cells(intCompRow + 1, intCol + 3) = "=VLOOKUP(D" & intCompRow & ",Actual!A1:BP150000," & (intCol) & ",FALSE)"
   'WorksheetFunction.VLookup(Sheet3.Cells(intCompRow, 4), Range("Test_Result"), intCol, False)
 
   Call CompareData(intCompRow, intCol)
   intCol = intCol + 1
   Wend
Application.Calculation = xlCalc
 
    Exit Sub
CalcBack:
Application.Calculation = xlCal
End Sub
 
Sub CompareData(intCompRow, intCol)
Dim xlCalc As XlCalculation
    xlCalc = Application.Calculation
    Application.Calculation = xlCalculationManual
    On Error GoTo CalcBack
'Take the actual against expected and shows the differences by color
    If IsError(Sheet3.Cells(intCompRow + 1, intCol + 3).Value) Then
      Sheet3.Cells(intCompRow + 1, intCol + 3) = "Actual Result Not Found"
      Sheet3.Cells(intCompRow + 1, intCol + 3).Font.ColorIndex = 5
      Sheet3.Cells(intCompRow + 1, intCol + 3).Font.Bold = True
      Sheet3.Rows(intCompRow + 1).Interior.ColorIndex = 40
      intCol = intRowCnt + 1 'To exit the while loop
    Else
        If Sheet3.Cells(intCompRow + 1, intCol + 3).Value = Sheet3.Cells(intCompRow, intCol + 3).Value Then
        Else
            Sheet3.Cells(intCompRow + 1, intCol + 3).Interior.ColorIndex = 40
            Sheet3.Cells(intCompRow + 1, intCol + 3).Font.ColorIndex = 5
            Sheet3.Cells(intCompRow + 1, intCol + 3).Font.Bold = True
        End If
 
    End If
   Application.Calculation = xlCalc
 
    Exit Sub
CalcBack:
Application.Calculation = xlCal
End Sub

 

[Bill Rockenbach]

Just some general ideas

1. Use Option Explicit and dimension all variables. Undimensioned variables get dimensioned as “variant” at run time. Variant variables take longer to process because the procedure has to make a determination as to what type the data is during run time
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
2.Use as few “select” statements as possible. Selection takes time.
Instead of
Range("A1", Selection.SpecialCells(xlLastCell)).Select
Selection.Copy
use
Range("A1", Range("A65356").End(xlUp)).Copy ‘(xlLastCell is unreliable)
<o></o>
Instead of
Range("A3:A100000").Select
Selection.ClearContents.
<o></o>
Use
<o></o>
Range("A3:A100000").ClearContents
<o></o>
3. Set calculation to manual at start of procedure. Unless you need calculations during the procedure don’t set calculation back to auto in the subprocedures. Each time you do that the workbook will calculate.
<o></o>
4. A wast of time
istead of
Dim xlCalc As XlCalculation
xlCalc = Application.Calculation
.
.
.
Application.Calculation = xlCalc
<o></o>
just use at end of the main procedure only ( unless you need calculations for a sub routine.)
Application.Calculation = xlAutomatic
<o></o>
5. Instead of looping through all 20,000 rows develop a formula that can be copy into all 20,000 rows with one statement. Then turn calculations on. After calculation then change the formulas to values.
<o></o>
6. combine as many processes into one loop were possible
<o></o>
check tese links
http://www.cpearson.com/excel/optimize.htm
http://www.ozgrid.com/VBA/SpeedingUpVBACode.htm
<o></o>
Avoid loops
http://www.ozgrid.com/VBA/VBALoops.htm
<o></o>
<o></o>

 

[Fazza]

hi Matt

Plainly the current code takes a very long time. Likely there are approaches that can do the required task very quickly - perhaps in seconds.

You might try a different approach to the question.

Rather than, here is a whole bunch of code how can it be faster, describe the set up & what you want to do, give some sample data, etc.

regards

 

[Norie]

One thing you could try is not looping the same cells twice like you appear to be in the first 2 subs.

 

[SIXTH SENSE]

One thing you could try is not looping the same cells twice like you appear to be in the first 2 subs.

your look up table is too large and may took vlookup some time to query multiple times.

I do not know if making it a database query using sql command will make it faster but if you can post some data to try, I would like to make some testing.

Please post sample data if you can or PM me .

 

[matt9man]

Bill thanks for the helpful tips I'll apply those this morning.

Sixth Sense- The majority of my data "confidential" but i'll try to give you some samples some time today.

Two Additional issues-
1.When my compare macro gets to pasting to the 10,004 row I get an overflow error. I have everything set as 'long' so I am confused why this is happening?
Here is the code and the highlighted code the debugger selected. I have supplied two procedures prior to the error procedure for reference.(Code is without bill's additions yet, doing that now)

2.When I have 10,000 + in each sheet it takes like a minute load up. I emptied my temp folder any other ideas?

Sub PopulateExp()
'Takes expected data populates it every other row until all expected are shown in the Compare Result Sheet
 
Dim intExpRow As Long
Dim intCompRow As Long
Dim intCol As Long
Application.ScreenUpdating = False
intExpRow = 3
intCompRow = 3
intCol = 1
Sheet3.Select
intRowCnt = Sheet4.Cells(1, 2)
Call ClearAllComp
While Sheet2.Cells(intExpRow, intCol) <> ""
   Sheet3.Cells(intCompRow, intCol) = "Expected"
   Sheet3.Cells(intCompRow, intCol + 1) = Sheet2.Cells(intExpRow, intCol + 1)
   Sheet3.Cells(intCompRow, intCol + 2) = Sheet2.Cells(intExpRow, intCol + 2)
   Sheet3.Cells(intCompRow, intCol + 3) = Sheet2.Cells(intExpRow, intCol)
 
   While (intCol <= intRowCnt)
   Sheet3.Cells(intCompRow, intCol + 4) = Sheet2.Cells(intExpRow, intCol + 3).Value
   intCol = intCol + 1
   Wend
 
   Sheet3.Rows(intCompRow).Select
 
    With Selection.Interior
        .ColorIndex = 34
        .Pattern = xlSolid
    End With
 
   Call PopulateAct(intCompRow)
 
   intCompRow = intCompRow + 2
   intExpRow = intExpRow + 1
 
 
intCol = 1
Wend
End Sub
Sub PopulateAct(intCompRow)
'Takes actual data populates below the expected result by using the key and the vlookup value in expected range
Dim intExpRow As Long
Dim intCol As Long
intCol = 1
intRowCnt = Sheet4.Cells(1, 2)
Sheet3.Select
   Sheet3.Cells(intCompRow + 1, intCol) = "Actual"
   Sheet3.Cells(intCompRow + 1, intCol + 1) = Sheet3.Cells(intCompRow, intCol + 1)
   Sheet3.Cells(intCompRow + 1, intCol + 2) = Sheet3.Cells(intCompRow, intCol + 2)
 
   While (intCol <= intRowCnt + 1)
   Sheet3.Cells(intCompRow + 1, intCol + 3) = "=VLOOKUP(D" & intCompRow & ",Actual!A1:BP150000," & (intCol) & ",FALSE)"
   'WorksheetFunction.VLookup(Sheet3.Cells(intCompRow, 4), Range("Test_Result"), intCol, False)
 
   Call CompareData(intCompRow, intCol)
   intCol = intCol + 1
   Wend
End Sub
 
Sub CompareData(intCompRow, intCol)
'Take the actual against expected and shows the differences by color
 
[COLOR=red][U]   If IsError(Sheet3.Cells(intCompRow + 1, intCol + 3).Value) Then[/U][/COLOR]
      Sheet3.Cells(intCompRow + 1, intCol + 3) = "Actual Result Not Found"
      Sheet3.Cells(intCompRow + 1, intCol + 3).Font.ColorIndex = 5
      Sheet3.Cells(intCompRow + 1, intCol + 3).Font.Bold = True
      Sheet3.Rows(intCompRow + 1).Interior.ColorIndex = 40
      intCol = intRowCnt + 1 'To exit the while loop
    Else
        If Sheet3.Cells(intCompRow + 1, intCol + 3).Value = Sheet3.Cells(intCompRow, intCol + 3).Value Then
        Else
            Sheet3.Cells(intCompRow + 1, intCol + 3).Interior.ColorIndex = 40
            Sheet3.Cells(intCompRow + 1, intCol + 3).Font.ColorIndex = 5
            Sheet3.Cells(intCompRow + 1, intCol + 3).Font.Bold = True
        End If
 
    End If
 
End Sub

Thanks again for all your help.

 

[matt9man]

Bill your 5. is a great idea do you know how? The problem I am running into is that the calcs(orvlookups) are needed for the paste. Because it goes expected result, then actual result, then expected and so on.
I'll keep trying but can't get it to work. Thanks

5. Instead of looping through all 20,000 rows develop a formula that can be copy into all 20,000 rows with one statement. Then turn calculations on. After calculation then change the formulas to values.

For the following code:

Sub PopulateExp()
'Takes expected data populates it every other row until all expected are shown in the Compare Result Sheet
 
Dim intExpRow As Long
Dim intCompRow As Long
Dim intCol As Long
Application.ScreenUpdating = False
intExpRow = 3
intCompRow = 3
intCol = 1
Sheet3.Select
intRowCnt = Sheet4.Cells(1, 2)
Call ClearAllComp
While Sheet2.Cells(intExpRow, intCol) <> ""
   Sheet3.Cells(intCompRow, intCol) = "Expected"
   Sheet3.Cells(intCompRow, intCol + 1) = Sheet2.Cells(intExpRow, intCol + 1)
   Sheet3.Cells(intCompRow, intCol + 2) = Sheet2.Cells(intExpRow, intCol + 2)
   Sheet3.Cells(intCompRow, intCol + 3) = Sheet2.Cells(intExpRow, intCol)
 
   While (intCol <= intRowCnt)
   Sheet3.Cells(intCompRow, intCol + 4) = Sheet2.Cells(intExpRow, intCol + 3).Value
   intCol = intCol + 1
   Wend
 
   Sheet3.Rows(intCompRow).Select
 
    With Selection.Interior
        .ColorIndex = 34
        .Pattern = xlSolid
    End With
 
   Call PopulateAct(intCompRow)
 
   intCompRow = intCompRow + 2
   intExpRow = intExpRow + 1
 
 
intCol = 1
Wend
End Sub
Sub PopulateAct(intCompRow)
'Takes actual data populates below the expected result by using the key and the vlookup value in expected range
Dim intExpRow As Long
Dim intCol As Long
intCol = 1
intRowCnt = Sheet4.Cells(1, 2)
Sheet3.Select
   Sheet3.Cells(intCompRow + 1, intCol) = "Actual"
   Sheet3.Cells(intCompRow + 1, intCol + 1) = Sheet3.Cells(intCompRow, intCol + 1)
   Sheet3.Cells(intCompRow + 1, intCol + 2) = Sheet3.Cells(intCompRow, intCol + 2)
 
   While (intCol <= intRowCnt + 1)
   Sheet3.Cells(intCompRow + 1, intCol + 3) = "=VLOOKUP(D" & intCompRow & ",Actual!A1:BP90000," & (intCol) & ",FALSE)"
   'WorksheetFunction.VLookup(Sheet3.Cells(intCompRow, 4), Range("Test_Result"), intCol, False)
 
   Call CompareData(intCompRow, intCol)
   intCol = intCol + 1
   Wend
End Sub
 
Sub CompareData(intCompRow, intCol)
'Take the actual against expected and shows the differences by color
    If IsError(Sheet3.Cells(intCompRow + 1, intCol + 3).Value) Then
      Sheet3.Cells(intCompRow + 1, intCol + 3) = "Actual Result Not Found"
      Sheet3.Cells(intCompRow + 1, intCol + 3).Font.ColorIndex = 5
      Sheet3.Cells(intCompRow + 1, intCol + 3).Font.Bold = True
      Sheet3.Rows(intCompRow + 1).Interior.ColorIndex = 40
      intCol = intRowCnt + 1 'To exit the while loop
    Else
        If Sheet3.Cells(intCompRow + 1, intCol + 3).Value = Sheet3.Cells(intCompRow, intCol + 3).Value Then
        Else
            Sheet3.Cells(intCompRow + 1, intCol + 3).Interior.ColorIndex = 40
            Sheet3.Cells(intCompRow + 1, intCol + 3).Font.ColorIndex = 5
            Sheet3.Cells(intCompRow + 1, intCol + 3).Font.Bold = True
        End If
 
    End If
 
End Sub

 

[Jonmo1]

In that sub, intcol and intcomprow are still Variants.
intcol is NOT dimmed as Long,

Change
Sub CompareData(intCompRow, intCol)
To
Sub CompareData(intCompRow As Long, intCol As Long)


Same here
Sub PopulateAct(intCompRow)
shoudl be
Sub PopulateAct(intCompRow As Long)

 

[Jonmo1]

Just some general ideas

<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
4. A wast of time
istead of
Dim xlCalc As XlCalculation
xlCalc = Application.Calculation
.
.
.
Application.Calculation = xlCalc
<o></o>
just use at end of the main procedure only ( unless you need calculations for a sub routine.)
Application.Calculation = xlAutomatic
<o></o>
<o></o>
<o></o>

I disagree with Point 4.
It is not a waste of time.
The time it takes is extremely small and unconsequential.
Unless it's inside a loop that makes it run thousands of times. In which case I would just say take it out of the loop, don't remove it all together.

The purpose for that bit of code is to ensure the calc method is reset to the setting it was at the time the macro began.
Some people like to leave calculation OFF.
So running a macro that turns it back on at the end can be annoying.
Also, if this macro was called from another macro that had turned calc off..it would disrupt the original macro because calc was turned back on.

 

[matt9man]

Hey jonmo i tried what you said but i keep getting a syntax error? Thanks

Sub PopulateAct(intCompRow)
'Takes actual data populates below the expected result by using the key and the vlookup value in expected range
Dim intExpRow As Long
Dim intCol As Long
intCol = 1
intRowCnt = Sheet4.Cells(1, 2)
Sheet3.Select
   Sheet3.Cells(intCompRow + 1, intCol) = "Actual"
   Sheet3.Cells(intCompRow + 1, intCol + 1) = Sheet3.Cells(intCompRow, intCol + 1)
   Sheet3.Cells(intCompRow + 1, intCol + 2) = Sheet3.Cells(intCompRow, intCol + 2)
   
   While (intCol <= intRowCnt + 1)
   Sheet3.Cells(intCompRow + 1, intCol + 3) = "=VLOOKUP(D" & intCompRow & ",Actual!A1:BP90000," & (intCol) & ",FALSE)"
   'WorksheetFunction.VLookup(Sheet3.Cells(intCompRow, 4), Range("Test_Result"), intCol, False)
    
   [COLOR=red]Call CompareData(intCompRow As Long, intCol As Long)
[/COLOR]   intCol = intCol + 1
   Wend
End Sub

Sub CompareData(intCompRow As Long, intCol As Long)
'Take the actual against expected and shows the differences by color
    If IsError(Sheet3.Cells(intCompRow + 1, intCol + 3).Value) Then
      Sheet3.Cells(intCompRow + 1, intCol + 3) = "Actual Result Not Found"
      Sheet3.Cells(intCompRow + 1, intCol + 3).Font.ColorIndex = 5
      Sheet3.Cells(intCompRow + 1, intCol + 3).Font.Bold = True
      Sheet3.Rows(intCompRow + 1).Interior.ColorIndex = 40
      intCol = intRowCnt + 1 'To exit the while loop
    Else
        If Sheet3.Cells(intCompRow + 1, intCol + 3).Value = Sheet3.Cells(intCompRow, intCol + 3).Value Then
        Else
            Sheet3.Cells(intCompRow + 1, intCol + 3).Interior.ColorIndex = 40
            Sheet3.Cells(intCompRow + 1, intCol + 3).Font.ColorIndex = 5
            Sheet3.Cells(intCompRow + 1, intCol + 3).Font.Bold = True
        End If
    
    End If
   
End Sub