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)

 

[Norie]

Just realised you wanted to clear other sheets too, perhaps something like this.

Sub ClearAllComp(ws As Worksheet)
    With ws
        ws.Range("A3", .Range("A" & Rows.Count).End(xlUp)).EntireRow.Clear
    End With
End Sub

Which can be called like this.

    ClearAllComp Sheet2
    
    ClearAllComp Sheet3
    
    ClearAllComp Sheet5

 

[matt9man]

Yea good point someone else mentioned that also. I am trying to get to not vlookup every cell to check but just vlookup the first key then make the other cells from other sheet = to compare sheet results. Then at end compare.

Still needs to vlookup the expected key in the actual data because find and match won't work because sometimes the keys may be unique with .'/.

 

[matt9man]

Any suggestions in after vlookuping the key to display all cells to the right of that vlookupval? I have a column count val that could be used as a paramter(its introwcnt). I tried this but got the vlookup but displayed the same actual results for every row.

Sub PopulateExp()
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

End Sub
Sub PopulateAct(intCompRow As Long)
Dim intExpRow As Long
Dim intCol As Long
intExpRow = 3
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)
   
   Sheet3.Cells(intCompRow + 1, intCol + 3) = "=VLOOKUP(D" & intCompRow & ",Actual!A1:ZZ100000," & (intCol) & ",FALSE)"
    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
      Else
        If Sheet3.Cells(intCompRow + 1, intCol + 3).Value = Sheet3.Cells(intCompRow, intCol + 3).Value Then
           While (intCol <= intRowCnt)
            Sheet3.Cells(intCompRow + 1, intCol + 4) = Sheet5.Cells(intExpRow, intCol + 1).Value
            intCol = intCol + 1 'to exit loop
           Wend
        
        Else
            While (intCol <= intRowCnt)
                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
                Sheet3.Cells(intCompRow + 1, 2).Value = "Difference"
                Sheet3.Cells(intCompRow, 2).Value = "Difference"
            Wend
        End If
   End If
   'While (intCol <= intRowCnt + 1)
   'Sheet3.Cells(intCompRow + 1, intCol + 3) = "=VLOOKUP(D" & intCompRow & ",Actual!A1:ZZ100000," & (intCol) & ",FALSE)"
   'WorksheetFunction.VLookup(Sheet3.Cells(intCompRow, 4), Range("Test_Result"), intCol, False)
    
   'Call CompareData(intCompRow, intCol)
   intCol = intCol + 1
   
End Sub

Thanks