Hoping I can get some help to speed up my code here
I have a range of values in column 'B' starting at B6 in a sheet titled 'Bin Range' and each value in this range needs to be looked up against another value lines in column A starting in A1 on a sheet called 'Remove Bins'
If there is a match then that cell containing that matching value in column B of the 'Bin Range' Sheet needs to be highlight red - Below is my attempt after some googling etc.
It works but just takes too long run more than a minute - The range in the ''Remove Bins' Sheet can be some 40,000 records, so my looping method is slow - and the amount of values in both ranges changes each day hence the need to make each range in the code dynamic
Sub CompareAndHighlight()
Application.ScreenUpdating = False
Dim rng1 As Range, rng2 As Range, i As Long, j As Long
For i = 1 To Sheets("Bin Range").Range("B" & Rows.Count).End(xlUp).Row
Set rng1 = Sheets("Bin Range").Range("B" & i)
For j = 1 To Sheets("Remove Bins").Range("a" & Rows.Count).End(xlUp).Row
Set rng2 = Sheets("Remove Bins").Range("a" & j)
If StrComp(Trim(rng1.Text), Trim(rng2.Text), vbTextCompare) = 0 Then
rng1.Interior.Color = 192
End If
Set rng2 = Nothing
Next j
Set rng1 = Nothing
Next i
Application.ScreenUpdating = True
End Sub
I have a range of values in column 'B' starting at B6 in a sheet titled 'Bin Range' and each value in this range needs to be looked up against another value lines in column A starting in A1 on a sheet called 'Remove Bins'
If there is a match then that cell containing that matching value in column B of the 'Bin Range' Sheet needs to be highlight red - Below is my attempt after some googling etc.
It works but just takes too long run more than a minute - The range in the ''Remove Bins' Sheet can be some 40,000 records, so my looping method is slow - and the amount of values in both ranges changes each day hence the need to make each range in the code dynamic
Sub CompareAndHighlight()
Application.ScreenUpdating = False
Dim rng1 As Range, rng2 As Range, i As Long, j As Long
For i = 1 To Sheets("Bin Range").Range("B" & Rows.Count).End(xlUp).Row
Set rng1 = Sheets("Bin Range").Range("B" & i)
For j = 1 To Sheets("Remove Bins").Range("a" & Rows.Count).End(xlUp).Row
Set rng2 = Sheets("Remove Bins").Range("a" & j)
If StrComp(Trim(rng1.Text), Trim(rng2.Text), vbTextCompare) = 0 Then
rng1.Interior.Color = 192
End If
Set rng2 = Nothing
Next j
Set rng1 = Nothing
Next i
Application.ScreenUpdating = True
End Sub