VBA Lookup between two ranges

Boffa

New Member
Joined
May 8, 2019
Messages
7
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,928
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
31,992
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,928
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
7
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
31,992
Office Version
365
Platform
Windows
Glad we could help & thanks for the feedback
 

Yard

Well-known Member
Joined
Nov 5, 2008
Messages
1,928
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
31,992
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,928
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 :)
 

Forum statistics

Threads
1,081,566
Messages
5,359,635
Members
400,542
Latest member
Fahkeet

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top