VBA Lookup between two ranges

Boffa

New Member
Joined
May 8, 2019
Messages
13
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
 

Yard

Well-known Member
Joined
Nov 5, 2008
Messages
1,929
You want to highlight the cells in Bin Range column B if that same value appears in column A of Remove Bins?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
33,524
Office Version
365
Platform
Windows
How about
VBA Code:
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", .Range("A" & Rows.Count).End(xlUp)).Value2
   End With
   For i = 1 To UBound(Ary)
      Dic.Item(Trim(Ary(i, 1))) = Empty
   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.Interior.Color = 192
      Next Cl
   End With
End Sub
 

Yard

Well-known Member
Joined
Nov 5, 2008
Messages
1,929
VBA Code:
Sub CompareAndHighlight_FIND()

Dim shtBins As Worksheet, shtRemove As Worksheet
Dim rngToCheck As Range, rngToTest As Range, rngFound As Range, rngToHighlight As Range
Dim i As Long, j As Long

Set shtBins = Worksheets("Bin Range")
Set shtRemove = Worksheets("Remove bins")

Set rngToCheck = shtBins.Range("B1")
With shtRemove
    Set rngToTest = Range(.Range("A1"), .Cells(Rows.Count, 1).End(xlUp))
End With

Do Until IsEmpty(rngToCheck.Value)
    Set rngFound = Nothing
    Set rngFound = rngToTest.Find(what:=rngToCheck.Value)
    If Not rngFound Is Nothing Then
        If rngToHighlight Is Nothing Then
            Set rngToHighlight = rngToCheck
        End If
        Set rngToHighlight = Union(rngToHighlight, rngToCheck)
    End If

    Set rngToCheck = rngToCheck.Offset(1, 0)

Loop

rngToHighlight.Interior.Color = 192

End Sub
 

Boffa

New Member
Joined
May 8, 2019
Messages
13
Thanks for the quick response guys.

Yard your code was fast but it didn't seem to highlight the matches ...Maybe how I pasted it in to the module, not sure

Fluff I'll study your code for some time it is lightning fast and works a treat ! -

Thanks again - Very much appreciate the help !
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
33,524
Office Version
365
Platform
Windows
Glad we could help & thanks for the feedback
 

Yard

Well-known Member
Joined
Nov 5, 2008
Messages
1,929
Yard your code was fast but it didn't seem to highlight the matches ...Maybe how I pasted it in to the module, not sure
How do you know it's fast then? ;)

I can't see why it doesn't highlight the cells, it works fine for me.

I wonder if it's something to do with me using the .Find method, it can't be finding the right things.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
33,524
Office Version
365
Platform
Windows
Just specifying the first argument in Range.Find is risky as it remembers the settings from the last time either it, or .Replace, were used.
 

Yard

Well-known Member
Joined
Nov 5, 2008
Messages
1,929
Just specifying the first argument in Range.Find is risky as it remembers the settings from the last time either it, or .Replace, were used.
Good point, was thinking to simplify to what was important for this, but that was too much of an omission. Thanks :)
 

Boffa

New Member
Joined
May 8, 2019
Messages
13
HI Yard meant in that it runs fast as the code still runs without throwing any errors but nothing highlights :)

Fluff How would we modify your code so rather than highlighting the matches in Red it instead returns the value it matched on the Remove Bins sheet but one column to the right

so if it exists in the remove bins list return the cell value to the right of that matched value to display it in the cell to the right of the matched value in the Bin Range Sheet (currently being highlighted red)

Basically a Vlookup returning column 2 value form Remove bins Sheet to Bin Range Sheet
 

Forum statistics

Threads
1,085,058
Messages
5,381,478
Members
401,743
Latest member
james909090

Some videos you may like

This Week's Hot Topics

Top