How to make a loop clear cache every 100,000 loops? - excel

Question

I have taken a code posted here somewhere and inserted an If statement that basically makes the sheet save every 10,000 loops. I read an advice somewhere that this stops excel from crashing completely. I am basically trying to match columns and finding duplicates by highlighting them/copying.
The issues is both columns that I am comparing have 100,000 rows each. I have been running the code for 4 hours now and it has only produced 1000 lines of matches... I am expecting at least 15,000 matches.
This time penalty is getting ridiculous, I am pretty sure there is a faster way to do it, but I am no expert in coding. :(
Sub Compare()
Dim Report As Worksheet
Dim i, j, z, colNum, vMatch As Integer
Dim lastRowA, lastRowB, lastRow, lastColumn As Integer
Dim ColumnUsage As String
Dim colA, colB, colC As String
Dim A, B, C As Variant
Set Report = Excel.ActiveSheet
vMatch = 1
'Select A and B Columns to compare
On Error Resume Next
Set A = Application.InputBox(Prompt:="Select column to compare", Title:="Column A", Type:=8)
If A Is Nothing Then Exit Sub
colA = Split(A(1).Address(1, 0), "$")(0)
Set B = Application.InputBox(Prompt:="Select column being searched", Title:="Column B", Type:=8)
If A Is Nothing Then Exit Sub
colB = Split(B(1).Address(1, 0), "$")(0)
'Select Column to show results
Set C = Application.InputBox("Select column to show results", "Results", Type:=8)
If C Is Nothing Then Exit Sub
colC = Split(C(1).Address(1, 0), "$")(0)
'Get Last Row
lastRowA = Report.Cells.Find("", Range(colA & 1), xlFormulas, xlByRows, xlPrevious).row - 1 ' Last row in column A
lastRowB = Report.Cells.Find("", Range(colB & 1), xlFormulas, xlByRows, xlPrevious).row - 1 ' Last row in column B
Application.ScreenUpdating = False
'***************************************************
For i = 3 To lastRowA 'change this NUMBER depending on which row the data starts
For j = 3 To lastRowB
z = j / 10000
If Report.Cells(i, A.Column).Value <> "" Then
If InStr(1, Report.Cells(j, B.Column).Value, Report.Cells(i, A.Column).Value, vbTextCompare) > 0 Then
vMatch = vMatch + 1
Report.Cells(i, A.Column).Interior.ColorIndex = 35 'Light green background
Range(colC & 1).Value = "Items Found"
Report.Cells(i, A.Column).Copy Destination:=Range(colC & vMatch)
If j = Int(j) Then
ThisWorkbook.Save
Exit For
Else
'Do Nothing
End If
End If
End If
Next j
Next i
If vMatch = 1 Then
MsgBox Prompt:="No Items Found", Buttons:=vbInformation
End If
'***************************************************
Application.ScreenUpdating = True
End Sub

Answer 1

Looking at your code... a few points:
Why not make A, B, C as string which hold the column you are looking at? This will increase performance. There is no need for the split and when you are looping instead of A.column you can just write A.
Are you trying to find complete matches (as oppose to a match in part of the text)? If so, set the values into a variable e.g. aValue = Report.Cells(j, A).Value and bValue = Report.Cells(j, B).Value and then compare them using if aValue = bValue then
Are you comparing one column against another, and then displaying results in a third column if there is a match in the SAME row? If so, what is the purpose of the j loop? Just loop through i (which will be your row) and compare value in both column A and column B.
If value can be on any row in the second column, then yes you can use the j loop, but an even faster way will be to use Excel in-built find function in VBA where you will search your value on column B:B. Using Excel Find in VBA is significantly faster.
What is z?
Worksheet save will only fail if bigger than the bounds of type Int. Is that what you want?
Your indentation needs to be corrected.
Exit For
Else
'Do Nothing
End If
Above needs to be indented 2-3 times
Implement the above improvements and let me know how you get on. Good luck.