VBA looking up value in different workbooks

[f00tpriint]

Hey together, unfortunately I'm a complete VBA beginner trying to figure out a way to do the following:

I would like have a Workbook "Analyze" in which I press a button and then start the process:

1. Ask me to input a "Part number"
2. Lookup this Part Number in all the excel files (approx. 20) located in a specific folder (which is also the folder where the makro file is located)
3. Once it has found the Value, copy the entire row to the Workbook "Analyze" - so I end up having the Part Number and all the values of its row from every excel file underneath each other

Done.

Anyone able to help me with this?

Thanks in advance!

 

[alansidman]

Several Questions needed to provide you with a workable solution
1. Name of Path that the Folder exists in that contains the 20 files
2. Is the part number located in the same column of each file
3. If 2 is Yes, then what column needs to searched

 

[f00tpriint]

Several Questions needed to provide you with a workable solution
1. Name of Path that the Folder exists in that contains the 20 files
2. Is the part number located in the same column of each file
3. If 2 is Yes, then what column needs to searched

1. I was planning on using Dir(ThisWorkboo.Path & *.xls*) function to keep it flexible as long as the macro executing file is in the same folder right?
2. Yes its always in Column A

Thanks a lot!

 

[f00tpriint]

Anybody able to help ?

 

[alansidman]

Here is some code that I have adapted but not tested as I don't have your files to test on. Test this on some sample data to ensure that it works before you take it live to your data. Back up you data to ensure you do not lose any information when you run this.

Option Explicit
Sub LoopAllExcelFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com modified ASidman 9/6/18


    Dim wb As Workbook
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String
    Dim FldrPicker As FileDialog
    Dim crit As String, lr As Long, i As Long, lrA As Long
    Dim This As Workbook
    Set This = ActiveWorkbook


    'Determine part to look up
    crit = InputBox("What is the part number to search?")


    'Optimize Macro Speed
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual


    'Retrieve Target Folder Path From User
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)


    With FldrPicker
        .Title = "Select A Target Folder"
        .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With


    'In Case of Cancel
NextCode:
    myPath = myPath
    If myPath = "" Then GoTo ResetSettings


    'Target File Extension (must include wildcard "*")
    myExtension = "*.xls*"


    'Target Path with Ending Extention
    myFile = Dir(myPath & myExtension)


    'Loop through each Excel file in folder
    Do While myFile <> ""
        'Set variable equal to opened workbook
        Set wb = Workbooks.Open(Filename:=myPath & myFile)


        'Determine last row in target
        lr = wb.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row
        'Ensure Workbook has opened before moving on to next line of code
        DoEvents


        'Search for Part Number
        For i = 1 To lr
            If wb.Worksheets(1).Range("A" & i) = crit Then
                lrA = This.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
                wb.Worksheets(1).Range("A" & i).EntireRow.Copy
                This.Sheets("Sheet1").Range("A" & lrA + 1).PasteSpecial xlPasteValues
            End If
        Next i


        'Save and Close Workbook
        wb.Close SaveChanges:=True


        'Ensure Workbook has closed before moving on to next line of code
        DoEvents


        'Get next file name
        myFile = Dir
    Loop


    'Message Box when tasks are completed
    MsgBox "Task Complete!"


ResetSettings:
    'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True


End Sub

 

[f00tpriint]

Works perfectly fine, thank you so much!!!