VBA Optimization

[Nickerzzzzz]

Hi All,

Hoping someone can point me in the right direction with regards to optimizing some vba.

The below code takes 12 seconds to run against 3000 cells selected in each worksheet, it looks at one column in each worksheet, looks for a duplicate value and highlights the cell accordingly, the problem is I have 400,000 cells in the first worksheet and 800,000 cells in the second worksheet and it takes an age to run, is there a way to optimise the code so it runs faster?

My vba is limited as I'm pretty much starting out and I have adapted the code found on the forums to suit...from what I can gather I need to read All the cell values into memory/an array, identify the duplicates within the array, and then write the array back to the sheet (Master), trouble is I don't have a clue how to do this and cant find any examples which guide me sufficiently

Any help or pointers would be much appreciated...

********************
Sub CompareRanges()
Dim Count As Integer
Dim StartTime As Double
Dim MinutesElapsed As String
Dim WorkRng1 As Range, WorkRng2 As Range, Rng1 As Range, Rng2 As Range
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
xTitleId = "Find Duplicate String"
Set WorkRng1 = Application.InputBox("Master Range (smallest)", xTitleId, "", Type:=8)
Set WorkRng2 = Application.InputBox("Range To Compare:", xTitleId, Type:=8)
Application.ScreenUpdating = False
StartTime = Timer
For Each Rng1 In WorkRng1
rng1Value = Rng1.Value
For Each Rng2 In WorkRng2
If rng1Value = Rng2.Value Then
Rng1.Interior.Color = VBA.RGB(255, 0, 0)
Exit For
End If
Next
Next
MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
MsgBox "The Code Took " & MinutesElapsed & " (hh:mm:ss) To Run", vbInformation
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

********************

 

[Nickerzzzzz]

Because of the amount of data you're looking at, I'm not sure that there is a "quick way" of doing it.
Another approach might be to use a formula, in a blank column on the sheet you want to highlight use this formula & copy down
=MATCH(A2,Records!A2:A20000,0)
Changing sheet name & ranges as required.
Not sure how long it will take, but values that match will return 1 & unmatched values will return #N/A

Thanks Fluff, my colleague initially tried using formulas which took an hour or so to run on a beefy machine and that's why I got involved to try and find a vba route, I tried your =MATCH against 10k lines and it took a while to copy down and complete, many thanks for the option/idea though.

 

[lhartono]

I have try the code by generating 400K vs 800K random numbers, and the code finish in 9 seconds. Nice....
I have modified the code a bit, so the hilite will be correct.

[COLOR=#0000cd]    For Each Rng1 In WorkRng1
        If hashSet.Exists(Rng1.Value) Then Rng1.Interior.Color = RGB(255, 0, 0)
    Next Rng1[/COLOR]

 

[Fluff]

Thanks Fluff, my colleague initially tried using formulas which took an hour or so to run on a beefy machine and that's why I got involved to try and find a vba route, I tried your =MATCH against 10k lines and it took a while to copy down and complete, many thanks for the option/idea though.

Glad WBD was able to sort it for you & thanks for the feedback.

You'll also find some good info on dictionaries here
https://excelmacromastery.com/vba-dictionary/