VBA Code to search fields in a different workbook

Wocnam

New Member
Joined
Aug 22, 2011
Messages
4
Hey Folks, let me first thank you for reading. This is my first post but I have learned so much from mrexcel.com over the last couple years. I've been asked to create something I fear might be just over my help, and am hoping someone would know if this is possible.

We have a data pull once a month and this data is split into 4 tabs. (A-H,I-M,N-T,U-Z) The data in this workbook has a last name in columns A, First Name, in column B, and some additional columns of data.

What I need to try to accomplish is to create a macro that:
1) Allows a user to browse to the correct worksheet that the search needs to be done on.
2) Will then the selected file's column A for a match (this would come from a user input box)
3) If a match is found on column A, I then need for a (2nd user input) search to be conducting on Column B
4) If there was a match to both columns, I then need the macro to pull the data from columns A -F.



So basically, I run the macro, it then has me browse to the file I want. Once I choose the file it will ask me for Last Name (Data in column A), then a second pop up will ask for the Last Name (Data in column B).
It will then search Column A (and possibly B) for a match. If a match isn't found, it will change to the next tab (I-M) and search again. This would continue through the next 2 tabs in no search is found on the first two.

When a match is found, the macro would then grab the data from rows A-F and put it in a worksheet from the workbook that the macro is built in.


Is this even possible or am I SOL? Many thanks if you got this far and hopefully I made some sense to this madness ;)
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Code:
Sub SearchOtherWorkbook()
Dim fPath As String, fName As String
Dim srchF As String, srchL As String
Dim wb As Workbook, NR As Long, FoundIT As Boolean
Dim wsDest As Worksheet, ws As Worksheet
Dim nFIND As Range, nFIRST As Range

fPath = "C:\2010\Test\"         'Default search path, remember the final \ in this string
Set wsDest = ThisWorkbook.Sheets("Report")                      'sheet info will appear in
NR = wsDest.Range("A" & wsDest.Rows.Count).End(xlUp).Row + 1    'target row for info

    With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = fPath
        .AllowMultiSelect = False
        .Filters.Add "All Files", "*.*"         'everything
        .Filters.Add "Excel Files", "*.xls", 1  'default
        .Show
        If .SelectedItems.Count > 0 Then
            fName = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With

srchL = Trim(Application.InputBox("Last Name?", "Last Name", Type:=2))
srchF = Trim(Application.InputBox("First Name?", "First Name", Type:=2))
If srchL = "False" Or srchF = "False" Then Exit Sub

Set wb = Workbooks.Open(fName)          'open the selected file
On Error Resume Next

For Each ws In wb.Worksheets            'check one sheet at a time
    Set nFIND = ws.Range("A:A").Find(srchL, LookIn:=xlValues, LookAt:=xlWhole)
    If Not nFIND Is Nothing Then        'last name found, check first name
        Set nFIRST = nFIND              'to exit loop if we find same cell second time
        Do
            If nFIND.Offset(, 1) = srchF Then           'check the first name
                nFIND.Resize(, 5).Copy wsDest.Range("A" & NR)   'copy if match
                FoundIT = True
                Exit For                                'exit the process
            End If
            Set nFIND = ws.Range("A:A").FindNext(nFIND) 'find next last name cell to check
        Loop Until nFIND.Address = nFIRST.Address       'loop until same first cell found again
        Exit For
    End If
Next ws

wb.Close False

    If FoundIT Then                         'indicate the result
        MsgBox "Data found and retrieved to row " & NR
    Else
        MsgBox "Data not found"
    End If

End Sub
 
Upvote 0
jbeaucaire, thanks for taking the time to help me! much appreciated!
I'll test this out and report back tomorrow!! Thanks again! :biggrin:
 
Upvote 0
jbeaucaire,

Reporting back, this was almost perfect! (Well it was perfect, except it turns out the Lname/Fname are in columns E and F, but that's my fault, and I was able to tweak what you gave me in order for it to search the correct columns)


It occured to me that the data that will be expected to be returned, could be from Columns A-D, but I have already told them that they will need to rearrange the order of the columns (and I will return the code back to how you gave it) if that is the case.

One thing unexpected, but was sweet was the fact that you could run this on multiple names, and it would just add the next line below the previous return. This is awesome in those cases where multiple names need to be searched!


One question (if it can be done...awesome!...if not...they get what they get!)

There will be times where the same name will be on the spreadsheet more than one time (think John Smith......crapload of John Smiths in the world)
Is there any way for this to return all matches instead of just the first match only?


Many many many thanks to you for helping me with this, you seriously rock!
 
Upvote 0
You know, try this... replace the code "Exit For" on line 40 with NR = NR + 1, I think by not exiting the process after we've found it, it will continue to look for bothname matches and we can keep adding them until we finally loop back to our first match.

Rich (BB code):
            If nFIND.Offset(, 1) = srchF Then           'check the first name
                nFIND.Resize(, 5).Copy wsDest.Range("A" & NR)   'copy if match
                FoundIT = True
                NR = NR + 1             'set the next row for more matches
            End If
 
Upvote 0

Forum statistics

Threads
1,224,599
Messages
6,179,831
Members
452,946
Latest member
JoseDavid

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