VBA - Identifying Matches from Range against Cells in another Workbook

S

spidaman

Board Regular
Joined
Jul 26, 2015
Messages
116
Office Version
  1. 365
Platform
  1. Windows
Can anyone correct my code pls as have struggled with this for a few days.

I have a range in the Active Workbook from which I want to identify matches with values in any cell in another workbook 'wb4' which has several sheets. The values from the original range include wildcard characters "?" and "*" in order to account for possible variations in the target workbook. If a match is found I'd like to format a particular cell in the corresponding row from the first workbook.

In case it helps understand what I am trying to achieve, the range from the first workbook is the result of a previous macro that has provided several variations for values in column A from the Active Workbook.

At the moment the code sticks on the MsgBox and the loop is clearly messed up.

Code: 
Sub Look_Up_NOIs()

Dim cel As Range
Dim Outrng As Range
Dim Lastrow As Long
Dim wb4 As Workbook
Dim foundCell As Range
Dim Sht As Worksheet


Set ws2 = ActiveWorkbook.Sheets("Other Numbers")
Set wb4 = Workbooks("Download Contacts")
Lastrow = ws2.Range("B" & Rows.Count).End(xlUp).Row
Set Outrng = ws2.Range("I2:R" & Lastrow)


For Each cel In Outrng


    For Each Sht In wb4.Worksheets
        
            With Sht.UsedRange
            
            Set foundCell = .Cells.Find(What:=cel)
        
                If Not foundCell Is Nothing Then
                    
                    Do Until foundCell Is Nothing
                    
                    cel.Interior.ColorIndex = 3
                    cel.Font.Bold = True
                    cel.Font.ColorIndex = 1
                        
                    Set foundCell = .FindNext(foundCell)
                    
                    Loop
                    
                Else
                
                    MsgBox "NOTHING FOUND!"
                    
                End If
                
            End With
    Set foundCell = Nothing
    Next
    
Next cel
            
End Sub

Thanks in advance for any help with this.
 
Sort by date Sort by votes
But the macro wouldn't continue unless I click the OK button on the MsgBox. Doesn't that mean the MsgBox should be after the Next but before the Next cel?

There are 460 cells in the OutRng and 17 sheets in wb4 (although some of them have virtually nothing on them).

I could probably target about 4 specific sheets by name I suppose to reduce the workload of the macro......
 
Upvote 0

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
If you move the msgbox it will appear regardless of if anything is found or not.
You are currently looping 7,820 times, so if a lot of your sheets don't have anything on them to find, the msgbox will appear a lot.
 
Upvote 0
Fluff said:
If you move the msgbox it will appear regardless of if anything is found or not.
You are currently looping 7,820 times, so if a lot of your sheets don't have anything on them to find, the msgbox will appear a lot.
Click to expand...

Hi again Fluff, I found that a variation of the code does work. If I search a specific worksheet such as:

Code: 
With Sht2.UsedRange

and removed the MsgBox altogether, then it does do what I want it to and doesn't take too long. So what I am thinking to do now is search each of the relevant worksheets only, which will narrow down the time frame. But I'd still like to include one final overall 'nothing found' message if no matches are found on any of the 5 or 6 worksheets. This is because with this data I'd expect there to be nothing found quite regularly.

Can you suggest a way of doing this please as not sure how to do it?

Also any chance you could explain the bracketed part of your code below as I'm not familiar with the terms you've used xlPart and commas etc?

Code: 
Set foundCell = .Cells.Find(cel.Value, , , xlPart, , , False, , False)

This is the code that is currently working, although I still need to add another For Each/Next section for each worksheets I want to search:

Code: 
Sub Look_Up_NOIs_v2()


Dim cel As Range
Dim Outrng As Range
Dim Lastrow As Long
Dim wb4 As Workbook
Dim foundCell As Range
Dim Sht1 As Worksheet, Sht2 As Worksheet, Sht3 As Worksheet, Sht4 As Worksheet, Sht5 As Worksheet, Sht6 As Worksheet


Set ws2 = ActiveWorkbook.Sheets("Other Phone Numbers")
Set ws3 = ActiveWorkbook.Sheets("Macro Controls & Outputs")
Set wb4 = Workbooks("Download Contacts")
Set Sht1 = wb4.Worksheets("Contacts Contacts")
Set Sht2 = wb4.Worksheets("Calls")
Set Sht3 = wb4.Worksheets("Organizer Notes")
Set Sht4 = wb4.Worksheets("Messages SMS")
Set Sht5 = wb4.Worksheets("Messages MMS")
Set Sht6 = wb4.Worksheets("Messages Chat")
    
Lastrow = ws2.Range("A" & Rows.Count).End(xlUp).Row
Set Outrng = ws2.Range("I2:R" & Lastrow)


For Each cel In Outrng
        
            With Sht2.UsedRange
            
            Set foundCell = .Cells.Find(cel.Value, , , xlPart, , , False, , False)
        
                If Not foundCell Is Nothing Then
                    
                    cel.Interior.ColorIndex = 3
                    cel.Font.Bold = True
                    cel.Font.ColorIndex = 1


'                    MsgBox "NOTHING FOUND!"
                    
                End If
                
            End With
            Set foundCell = Nothing
    
Next cel

End Sub

Thanks Fluff
 
Upvote 0
Have a look here for the various parameters for .Find https://docs.microsoft.com/en-us/office/vba/api/excel.range.find
As long as the parameters are in order you don't need to specify the name (ie What:=, Lookin:= etc ) so the commas are just there as place holders.
For the msgbox try
Code: 
Sub Look_Up_NOIs_v2()
   Dim cel As Range
   Dim Outrng As Range
   Dim Lastrow As Long
   Dim wb4 As Workbook
   Dim foundCell As Range
  [COLOR=#ff0000] Dim NotFound As Boolean[/COLOR]
   Dim Sht1 As Worksheet, Sht2 As Worksheet, Sht3 As Worksheet, Sht4 As Worksheet, Sht5 As Worksheet, Sht6 As Worksheet
   
   Set Ws2 = ActiveWorkbook.Sheets("Other Phone Numbers")
   Set ws3 = ActiveWorkbook.Sheets("Macro Controls & Outputs")
   Set wb4 = Workbooks("Download Contacts")
   Set Sht1 = wb4.Worksheets("Contacts Contacts")
   Set Sht2 = wb4.Worksheets("Calls")
   Set Sht3 = wb4.Worksheets("Organizer Notes")
   Set Sht4 = wb4.Worksheets("Messages SMS")
   Set Sht5 = wb4.Worksheets("Messages MMS")
   Set Sht6 = wb4.Worksheets("Messages Chat")
   
   Lastrow = Ws2.Range("A" & Rows.Count).End(xlUp).Row
   Set Outrng = Ws2.Range("I2:R" & Lastrow)
   For Each cel In Outrng
      With Sht2.UsedRange
         Set foundCell = .Cells.Find(cel.Value, , , xlPart, , , False, , False)
         If Not foundCell Is Nothing Then
            cel.Interior.ColorIndex = 3
            cel.Font.Bold = True
            cel.Font.ColorIndex = 1
        [COLOR=#ff0000] Else
            NotFound = True
         End If[/COLOR]
      End With
      Set foundCell = Nothing
   Next cel
  [COLOR=#ff0000] If NotFound Then MsgBox "Nothing found"[/COLOR]
End Sub
 
Upvote 0
That's brilliant thanks Fluff. I'll have a look at the link. Also will try your MsgBox suggestion........

Thanks.....much appreciated.

Happy New Year!
 
Upvote 0
Hi Fluff

Unfortunately that tweak to the MsgBox didn't seem to work. The Msgbox was appearing even when there were matches between cells in the Outrng and wb4. Furhtermore I am now getting error message #9 - Subscript out of range message for this line:

Code: 
Set wb4 = Workbooks("Download Contacts")

This is the full code:

Code: 
Sub Look_Up_NOIs_v2()


Dim cel As Range
Dim Outrng As Range
Dim Lastrow As Long
Dim wb4 As Workbook
Dim foundCell As Range
Dim NotFound As Boolean
Dim Sht1 As Worksheet, Sht2 As Worksheet, Sht3 As Worksheet, Sht4 As Worksheet, Sht5 As Worksheet, Sht6 As Worksheet


Set ws2 = ActiveWorkbook.Sheets("Other Phone Numbers")
Set ws3 = ActiveWorkbook.Sheets("Macro Controls & Outputs")
Set wb4 = Workbooks("Download Contacts") ' error message 9 on this line
Set Sht1 = wb4.Worksheets("Contacts Contacts")
Set Sht2 = wb4.Worksheets("Calls")
Set Sht3 = wb4.Worksheets("Organizer Notes")
Set Sht4 = wb4.Worksheets("Messages SMS")
Set Sht5 = wb4.Worksheets("Messages MMS")
Set Sht6 = wb4.Worksheets("Messages Chat")

    
Lastrow = ws2.Range("A" & Rows.Count).End(xlUp).Row
Set Outrng = ws2.Range("I2:R" & Lastrow)


    For Each cel In Outrng
                  
                With Sht1.UsedRange
                
                Set foundCell = .Cells.Find(cel.Value, , , xlPart, , , False, , False)
            
                    If Not foundCell Is Nothing Then
                        
                        cel.Interior.ColorIndex = 3
                        cel.Font.Bold = True
                        cel.Font.ColorIndex = 1
                        
                    Else
                    
                        NotFound = True
                        
                    End If
                    
                End With
        
                Set foundCell = Nothing
        
    Next cel


    For Each cel In Outrng
                
                With Sht2.UsedRange
                
                Set foundCell = .Cells.Find(cel.Value, , , xlPart, , , False, , False)
            
                    If Not foundCell Is Nothing Then
                        
                        cel.Interior.ColorIndex = 3
                        cel.Font.Bold = True
                        cel.Font.ColorIndex = 1
                        
                    Else
                    
                        NotFound = True
                        
                    End If
                
                End With
        
                Set foundCell = Nothing
        
    Next cel


    For Each cel In Outrng
                
                With Sht3.UsedRange
                
                Set foundCell = .Cells.Find(cel.Value, , , xlPart, , , False, , False)
            
                    If Not foundCell Is Nothing Then
                        
                        cel.Interior.ColorIndex = 3
                        cel.Font.Bold = True
                        cel.Font.ColorIndex = 1
                   
                    Else
                    
                        NotFound = True
                    
                    End If
                    
                End With
                
                Set foundCell = Nothing
    
    Next cel


    For Each cel In Outrng
                
                With Sht4.UsedRange
                
                Set foundCell = .Cells.Find(cel.Value, , , xlPart, , , False, , False)
            
                    If Not foundCell Is Nothing Then
                        
                        cel.Interior.ColorIndex = 3
                        cel.Font.Bold = True
                        cel.Font.ColorIndex = 1
                        
                    Else
                    
                        NotFound = True
                        
                    End If
                
                End With
                
                Set foundCell = Nothing
        
    Next cel


    For Each cel In Outrng
                
                With Sht5.UsedRange
                
                Set foundCell = .Cells.Find(cel.Value, , , xlPart, , , False, , False)
            
                    If Not foundCell Is Nothing Then
                        
                        cel.Interior.ColorIndex = 3
                        cel.Font.Bold = True
                        cel.Font.ColorIndex = 1
                        
                    Else
                    
                        NotFound = True
                        
                    End If
                    
                End With
                
                Set foundCell = Nothing
    
    Next cel


    For Each cel In Outrng
                
                With Sht6.UsedRange
                
                Set foundCell = .Cells.Find(cel.Value, , , xlPart, , , False, , False)
            
                    If Not foundCell Is Nothing Then
                        
                        cel.Interior.ColorIndex = 3
                        cel.Font.Bold = True
                        cel.Font.ColorIndex = 1
                        
                    Else
                    
                        NotFound = True
                        
                    End If
                    
                End With
    
                Set foundCell = Nothing
    
    Next cel
    
'If NotFound Then MsgBox "Nothing found"
        
    
End Sub

Any ideas why I'm getting the error code now?
 
Upvote 0
Either you don't have an open workbook called "Download Contacts", or your system settings have changed.
 
Upvote 0
Fluff said:
Either you don't have an open workbook called "Download Contacts", or your system settings have changed.
Click to expand...

I changed "Download Contacts" to "Download Contacts.xlsx" and this solved the problem. Don't understand why though...!? :confused:

Any ideas about the Msgbox return for no matches between the Outrng and wb4?
 
Upvote 0
The message box will appear if any of those sheets do not have a match
 
Upvote 0
You must log in or register to reply here.

Similar threads

Logit
  • Question Question
Search In Other Workbook - Copy/Paste Offset Data To First Workbook - Repeat Process
Replies
7
Views
329
Logit
Logit
K
  • Solved
Code to search job id from multiple sources and update main spreadsheet.
2
Replies
10
Views
643
mumps
mumps
G
  • Solved
Print resultValue from VBA script
Replies
5
Views
697
georgeeye
G
N
  • Solved
Copy/paste a row from within a loop, before that loop moves on to next cell
Replies
5
Views
525
Joe4
Joe4
O
  • Question Question
Prioritize rows based on info in cells
Replies
1
Views
465
CesarF
CesarF

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top