Finding Matching Data in Separate Workbooks

[AussieJac]

Hi all,

I have the following macro that finds a contract number listed in Column C in one sheet to where it appears in the following 10 sheets (in column B) then it returns the message "Found in Data Base".

What I want is this to work with two separate workbooks - one containing a list of contract numbers to be found in the second workbook. And instead of returning "Found in Data Base" when a match is found, I would like it to copy the Name of the contract corresponding the the contract number as a check.

In the macro below I have opened up the second workbook but I am unsure how to tell the macro to switch between the two workbooks.

Sub FindMatch()
' Open Data Base file to facilitate matching process.
' Check for matching data

Dim currentfile As String
Dim WS As Worksheet
Dim R As Range

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Workbooks.Open Filename:= _
        "G:\Registration\Data List amended for DOD.xls"
    MsgBox ("Opening DataBase")
    
    Windows("Claimed Matching Data.xls").Activate
    Sheets("M - Matching Data").Select
    [L3].Select
    While ActiveCell.Offset(0, -9) <> Empty
       
        For Each WS In Sheets(Array("List A", "List B", "List C", "List D", "List E", "List F"))
            Set R = WS.Range("b2:b3000").Find(ActiveCell.Offset(0, -9))

            If Not R Is Nothing Then
                ActiveCell.Offset(0, 1).Value = "Found in Data Base"
                  
        Exit For
            End If
        Next
        ActiveCell.Offset(1).Select
        
    Wend
End Sub

Any help would be appreciated.
Jac

 

[Macropheliac]

This should do it:

Sub test2()
' Open Data Base file to facilitate matching process.
' Check for matching data

Dim currentfile As String
Dim WS As Worksheet
Dim R As Range
Dim Myvalue As String
Dim Myrange As Range
Dim Tcell As Range

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'    Workbooks.Open Filename:= _
'        "G:\Registration\Data List amended for DOD.xls"
'    MsgBox ("Opening DataBase")
 Workbooks.Open Filename:=ThisWorkbook.Path & "\Data List amended for DOD.xls"
 ThisWorkbook.Sheets("M - Matching Data").Activate
  
For Each Tcell In ActiveSheet.Range("C3:C" & ActiveSheet.Range("C65536").End(xlUp).Row)

    Set Myrange = Tcell.Offset(0, 1)
    Myvalue = Tcell.Value
    
        For Each WS In Workbooks("Data List amended for DOD.xls").Sheets
           Select Case WS.Name
              Case "List A", "List B", "List C", "List D", "List E", "List F"
                 With WS.Range("b2:b3000")
        
                     Set R = .Find(Myvalue, LookIn:=xlValues)
                     If Not R Is Nothing Then
                          Myrange.Offset(0, 9).Value = "Found in Data Base"
                          Myrange.Offset(0, 10).Value = R.Offset(0, 3).Value
                     End If
                 End With
           End Select
        Next WS
        Next Tcell
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

BTW: The error was due to a 1 in the place of an L in the following line:

("C65536").End(xlUp).Row)

I told you I don't sleep enough. I don't know how I managed that.


Mac

 

[AussieJac]

All hail the Macro guru........ ray:

It works a treat!!!

Now, go get some sleep.

cheers
Jacqui

 

[Macropheliac]

Thank you, my friend! I'm glad it works for you.

 

[AussieJac]

I've been mucking around with it some more and thanks to your great tutoring I have now got it copying from one spreadsheet to the other but I am having trouble trying to highlight the line in the database with a color index !
I've been playing with the following line and inserting it after "Myrange.Offset(0, 9).Value = "Found in Data Base""

Select.Row.Interior.ColorIndex = 3


I've tried various combinations but no joy!

 With WS.Range("b2:b3000")
        
Set R = .Find(Myvalue, LookIn:=xlValues, lookat:=xlWhole)
If Not R Is Nothing Then
                     
Myrange.Offset(0, 9).Value = "Found in Data Base"
                          

                          
Myrange.Offset(0, 10).Value = R.Value 'copies contract number from database
Myrange.Offset(0, 11).Value = R.Offset(0, 2).Value 'copies Date of Birth from database
Myrange.Offset(0, 12).Value = R.Offset(0, 3).Value 'copies Name from database
R.Offset(0, 15).Value = Myrange.Offset(0, 4).Value'copies Claim No TO database
'R.Offset(0, 16).Value = Myrange.Offset(0, 5).Value'copies Amount Paid TO database

 

[Macropheliac]

Hi Jac! If I understand correctly, you want to highlight the Row in which the match is found? Try this:

Myrange.Offset(0, 9).Value = "Found in Data Base" 
R.EntireRow.Interior.ColorIndex=3

 

[AussieJac]

Hi Mac
Thanks again. It works perfectly (as always)

Hope you had a great weekend.
and thanks again for your help.

Jac