Application.Match

[Matt87]

Hi all, I have some coding which loops through a list of references numbers, and searches multiple worksheets for a the matching reference number. This works fine but what I need it to is to return an offset value(s) once the matching reference number has been found. So the original list of reference numbers is on sheet 1 in column A, the macro then looks through each number, searches the rest of the workbook to find an equal matching reference and at this point I need the macro to return the Value of the reference number and the department where its processed (which are all in the next 2 columns). This is the coding I have so far, due to the dynamic nature of the macro I can't quite figure out how to return the desired figures.

Sub FindMatches()
Application.ScreenUpdating = False
Dim var As Variant, Isheet As Integer, irow As Long, Irowl As Long, bln  As Boolean
Dim RS As Worksheet
FR = Cells(Rows.Count, 1).End(xlUp).row
Set RS = Sheets("S1")
  
 Irowl = Sheets(3).Cells(Rows.Count, "A").End(xlUp).Offset(0, 4).row
 For irow = 3 To Irowl
 If Not IsEmpty(Cells(irow, 16)) Then
 For Isheet = ActiveSheet.Index + 1 To Worksheets.Count
            bln = False
            var = Application.match(Cells(irow, 16).Value, Worksheets(Isheet).Columns(16), 0)
            If Not IsError(var) Then
               bln = True
               Exit For
            End If
         Next Isheet
      End If
      If bln = False Then
         Cells(irow, 16).Font.Bold = False
         Else
         
         'This is where I need the desired coding to go
         
         
         RS.Select
         Range("A200").End(xlUp).Offset(1, 0).PasteSpecial xlValues
         Sheets(3).Select
      End If
   Next irow
Application.ScreenUpdating = True
End Sub

 

[JackDanIce]

Welcome to the board. Untested, however, try:

Sub FindMatches_v1()

    Dim LR  As Long
    Dim x   As Long
    Dim i   As Long
    Dim wks As Worksheet
    Dim w   As Worksheet
    Dim r   As Range
    
    Set wks = Sheets("S1")
    
    Application.ScreenUpdating = False
    
    With Sheets(3)
        LR = .Cells(Rows.Count, 1).End(xlUp).row
        For x = 3 To LR
            For Each w In ThisWorkbook.Worksheets
                With w
                    Select Case .Name
                        Case Is = "S1", Sheets(3).Name
                        Case Else
                            i = .Cells(.Rows.Count, 16).End(xlUp).row
                            On Error Resume Next
                                Set r = .Cells(1, 16).Resize(i).find(Sheets(3).Cells(x, 16).Value, LookIn:=xlValues, lookat:=xlWhole)
                            On Error GoTo 0
                            If Not r Is Nothing Then
                                wks.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 3).Value = rng.Resize(, 3).Value
                                Set r = Nothing
                            Else
                                Sheets(3).Cells(x, 16).Font.Bold = False
                            End If
                    End Select
                End With
            Next w
        Next x
    End With
    
    Application.ScreenUpdating = True
    
    Set wks = Nothing

End Sub