VBA to search for value in all sheets of other workbook

[esukei]

Hello everyone

I have two files.
1. Workfile (where the macro will be stored)
2. Valuefile

I want to search for the value in C16 of the workfile in column D in all sheets of the valuefile.
If found copy the value of column O of the found row to the workfile (column G).

How can I achieve this?
Thanks in advance for your help.

[Kaper]

Try:

Sub test()
Dim wks As Worksheet, rng As Range
With ThisWorkbook.Sheets("Sheet1")
  For Each wks In Workbooks("Valuefile.xlsx").Worksheets
    Set rng = wks.Columns("D:D").Find(what:=.Range("C16").Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not rng Is Nothing Then
      .Range("G16").Value = rng.Offset(0, 11).Value
      Exit For
    End If
  Next wks
End With
End Sub

[esukei]

Try:

Sub test()
Dim wks As Worksheet, rng As Range
With ThisWorkbook.Sheets("Sheet1")
  For Each wks In Workbooks("Valuefile.xlsx").Worksheets
    Set rng = wks.Columns("D:D").Find(what:=.Range("C16").Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not rng Is Nothing Then
      .Range("G16").Value = rng.Offset(0, 11).Value
      Exit For
    End If
  Next wks
End With
End Sub

Thank you. This works if the Valuefile is already open.
How can I add a network path to a folder and open the Excel file in it automatically?

[jindon]

For the files uploaded.

Sub test()
    Dim myDir As String, fn As String, myVal, i As Long, x
    myDir = ThisWorkbook.Path  '<--- change this to actual folder path
    fn = "Valuefile.xlsx"
    fn = myDir & "\[" & fn & "]"
    myVal = Sheets("sheet1").[c16]
    If Not IsNumeric(myVal) Then myVal = Chr(34) & myVal & Chr(34)
    For i = 1 To 3
        x = ExecuteExcel4Macro("match(" & myVal & ",'" & fn & "sheet" & i & "'!c4:c4,0)")
        If IsNumeric(x) Then
            Sheets("sheet1").[g16] = ExecuteExcel4Macro("'" & fn & "sheet" & i & "'!r" & x & "c15")
            Exit For
        End If
    Next
End Sub

[esukei]

Thank you for your code.
Unfortunately the sheets are not called "Sheet 1" or "Sheet 2" as in my example. They can have random names and can be more than 3 sheets per workbook.

[jindon]

Change to

Sub test()
    Dim myDir As String, fn As String, myVal, e, x, ws, msg As String
    myDir = ThisWorkbook.Path  '<--- change this to actual folder path
    fn = "Valuefile.xlsx"
    ws = GetSheetNames(myDir & "\" & fn)
    fn = myDir & "\[" & fn & "]"
    myVal = Sheets("sheet1").[c16]
    If Not IsNumeric(myVal) Then myVal = Chr(34) & myVal & Chr(34)
    For Each e In ws
        x = ExecuteExcel4Macro("match(" & myVal & ",'" & fn & e & "'!c4:c4,0)")
        If IsNumeric(x) Then
            Sheets("sheet1").[g16] = ExecuteExcel4Macro("'" & fn & e & "'!r" & x & "c15")
            msg = "Found In " & e & "!D" & x
            Exit For
        End If
    Next
    MsgBox IIf(Len(msg), msg, "Not found")
End Sub

Function GetSheetNames(fn As String)
    Dim db As Object, tbl As Object, i As Long, x
    Set db = CreateObject("DAO.DBEngine.120").OpenDatabase(fn, False, False, "excel 5.0;HDR=No")
    ReDim x(0 To db.TableDefs.Count - 1)
    For i = 0 To db.TableDefs.Count - 1
        x(i) = Replace(db.TableDefs(i).Name, "$", "")
    Next
    GetSheetNames = x: db.Close
End Function

[esukei]

Change to

Sub test()
    Dim myDir As String, fn As String, myVal, e, x, ws, msg As String
    myDir = ThisWorkbook.Path  '<--- change this to actual folder path
    fn = "Valuefile.xlsx"
    ws = GetSheetNames(myDir & "\" & fn)
    fn = myDir & "\[" & fn & "]"
    myVal = Sheets("sheet1").[c16]
    If Not IsNumeric(myVal) Then myVal = Chr(34) & myVal & Chr(34)
    For Each e In ws
        x = ExecuteExcel4Macro("match(" & myVal & ",'" & fn & e & "'!c4:c4,0)")
        If IsNumeric(x) Then
            Sheets("sheet1").[g16] = ExecuteExcel4Macro("'" & fn & e & "'!r" & x & "c15")
            msg = "Found In " & e & "!D" & x
            Exit For
        End If
    Next
    MsgBox IIf(Len(msg), msg, "Not found")
End Sub

Function GetSheetNames(fn As String)
    Dim db As Object, tbl As Object, i As Long, x
    Set db = CreateObject("DAO.DBEngine.120").OpenDatabase(fn, False, False, "excel 5.0;HDR=No")
    ReDim x(0 To db.TableDefs.Count - 1)
    For i = 0 To db.TableDefs.Count - 1
        x(i) = Replace(db.TableDefs(i).Name, "$", "")
    Next
    GetSheetNames = x: db.Close
End Function

Thank you.
Unfortunately the line below gets always an error:

 
x = ExecuteExcel4Macro("match(" & myVal & ",'" & fn & e & "'!c4:c4,0)")

Attachment 809098

[esukei]

Ok I was able to get it running.
Thank you all for your help.

myDir = "\\mypath\"
                            fn = Dir(myDir & "*.xls*")
                            
                            Set swb = Workbooks.Open(myDir & fn)
                            For Each sSh In swb.Worksheets
                                Set rng = sSh.Columns("D:D").Find(what:=.Range("C16").Value, LookIn:=xlValues, lookat:=xlWhole)
                                If Not rng Is Nothing Then
                                    .Range("G16").Value = rng.Offset(0, 11).Value
                                    
                                    Exit For
                                End If
                            Next sSh