VBA - Find Matching Cell Value in a Separate Workbook

**SnareStudios** · 09-16-2010, 02:13 PM

I am attempting to write a macro that lets a user select a cell containing a unique value, run the macro which prompts the user to select a workbook to "search" for that value in and return the row number of where that value was found to the original workbook.

Example:
- Highlight a cell with "ABC123" in Workbook1
- Run the macro
- Select a separate workbook (Workbook2)
- The macro searches that selected Workbook2 for "ABC123"
- If found it returns the row number where this unique "ABC123" value was found in Workbook2 to the ORIGINAL Workbook1.

Any help would be GREATLY appreciated.

**blane245** · 09-16-2010, 03:57 PM

Here's some starter code. I don't know where you want to put the row number, so I put it in the cell next to the active cell.

Option Explicit

Sub FindValue()

' get the value from the active cell
Dim theValue As String
Dim theCell As Range
theValue = ActiveCell.Value
Set theCell = ActiveCell

' ask the user for the workbook to be searched
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "Excel Files", "*.xl*"
    If (.Show = -1) Then ' proceed if a file is selected
    
        ' open the selected file
        Dim FileName As String
        FileName = .SelectedItems(1)
        Dim wbB As Workbook
        Set wbB = Workbooks.Open(FileName:=FileName, ReadOnly:=True)
        
        ' search the first sheet
        Dim fnd As Range
        Set fnd = wbB.Sheets(1).UsedRange.Find(theValue)
        
        ' if found, put the row number next to the value
        If (Not fnd Is Nothing) Then
            theCell.Offset(0, 1).Value = fnd.Row
        Else
            theCell.Offset(0, 1).Value = "Not Found"
        End If
        
        wbB.Close SaveChanges:=False
        
    End If
End With

End Sub

**SnareStudios** · 09-16-2010, 04:13 PM

The macro will only search Sheet1 (or whatever the first sheet is named) of the chosen workbook. It will only need to search that first sheet.

I am just wanting the row number assigned to a variable for later use. It doesn't need to be set to a cell value. Eventually it will be set to a cell formula.

**SnareStudios** · 09-16-2010, 04:29 PM

I was also wanting it to loop through a selection of cells (not just a single cell). The selection will be all within a single column.

**SnareStudios** · 09-16-2010, 05:16 PM

I have a column (Column B) of serial numbers in a reporting workbook (Workbook1). I will select a range (lets say the first 5). I am then going to run the macro which will prompt for me to open another worksheet containing more detailed information for each SN in the selection (Workbook2).

It will then loop through the selection in Workbook1 and find the corresponding row number for each matching cell value in Workbook2.

It will then link Column E + row of that selected cell in Workbook1 to Column E + Row Value of where it found the match in Workbook2. Just referencing that cell as a formula. Example: ='C:\Example\[Workbook2.xlsx]Sheet1'!$E$8

**blane245** · 09-17-2010, 08:07 AM

try this one. It doesn't insist that the selected cells are in column B or even continguous, but it will always but the resulting formula in column E.

Option Explicit

Sub FindandReference()

' get the reference to the active sheet
Dim theSheet As Worksheet
Set theSheet = ActiveSheet

' get the range of selected cells
Dim theActiveRange As Range
Set theActiveRange = Selection

' ask the user for the workbook to be searched
' ask the user for the workbook to be searched
With Application.FileDialog(msoFileDialogFilePicker)
    .Title = "Select the Excel file to be searched"
    .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "Excel Files", "*.xl*"
    If (.Show = 0) Then ' abort if the user cancels the selection
        Exit Sub
    End If
    
    ' open the selected file
    Dim FileName As String
    FileName = .SelectedItems(1)
    Dim wbB As Workbook
    Set wbB = Workbooks.Open(FileName:=FileName, ReadOnly:=True)
    
    ' build the cell reference prefix
    Dim thePath As String
    Dim theName As String
    Dim thePathEnd As Long
    thePathEnd = InStrRev(FileName, "\")
    thePath = Mid(FileName, 1, thePathEnd)
    theName = Mid(FileName, thePathEnd + 1)
    Dim theReferencePrefix As String
    theReferencePrefix = "'" & thePath & "[" & theName & "]Sheet1'!"
End With


' loop through all of the cells in the selected range
Dim theCell As Range
For Each theCell In theActiveRange
    
    ' get the value from this cell
    Dim theValue As String
    theValue = theCell.Value
    
    ' get the row of this cell and build a reference to
    ' the cell's row and column E
    Dim theRow As Long
    theRow = theCell.Row
    Dim theCellReference As Range
    Set theCellReference = theSheet.Cells(theRow, 5)
        
    ' search the first sheet for this value
    Dim fnd As Range
    Set fnd = wbB.Sheets(1).UsedRange.Find(theValue)
    
    ' if found, put a reference to this cell in the
    ' first workbook in column E
    If (Not fnd Is Nothing) Then
        
        ' get the reference to this row and column E
        
        ' set the formula in this cell to  refer to
        ' the found cell
        theCellReference.Formula = "=" & theReferencePrefix & fnd.Address
    Else
        theCellReference.Value = "Not Found"
    End If
Next theCell
    
        
wbB.Close SaveChanges:=False

End Sub