VBA Lookup between two ranges

[Boffa]

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

 

[Fluff]

How about

Sub Boffa()
   Dim Ary As Variant
   Dim i As Long
   Dim Dic As Object
   Dim Cl As Range
   
   Set Dic = CreateObject("scripting.dictionary")
   Dic.CompareMode = 1
   With Sheets("Remove Bins")
      Ary = .Range("A1:B" & .Range("A" & Rows.Count).End(xlUp).Row).Value2
   End With
   For i = 1 To UBound(Ary)
      Dic.Item(Trim(Ary(i, 1))) = Ary(i, 2)
   Next i
   With Sheets("Bins")
      For Each Cl In .Range("B6", .Range("B" & Rows.Count).End(xlUp))
         If Dic.Exists(Trim(Cl.Value)) Then Cl.Offset(, 1).Value = Dic(Trim(Cl.Value))
      Next Cl
   End With
End Sub

 

[Boffa]

Perfect Thanks again Fluff spot on again, works great !

 

[Fluff]

You're welcome & thanks for the feedback