Urgent problem: How to extract data from sheet automatically based on keyword string

Hi all,

I have a problem with the following codes combining them into one code, that imports the data from multiple input files into sheet 1 and search for specific 'key words' on each imported file and returns the result to sheet 2. The results from each imported file is to be presented in the first 'empty' row on sheet 2. Hence, if 10 files are imported, 10 rows will be filled with data.

The code for importing the files in sequence is:

Code for the button that enables the index funtion:

Private Sub btnBrowse_Click()
    
    Dim oShell As Object
    Dim strFolderPath As String
    
    Set oShell = CreateObject("Shell.Application")
    On Error Resume Next
    strFolderPath = oShell.browseforfolder(0, "Select Folder", 0).self.Path & Application.PathSeparator
    Set oShell = Nothing
    On Error GoTo 0
    
    If Len(strFolderPath) > 0 Then Me.txtFolderPath.Text = strFolderPath
End Sub

Code that will be ran upon loading each file:

Private Sub btnExractData_Click()
    
    Dim wb As Workbook
    Dim wsData As Worksheet
    Dim wsResults As Worksheet
    Dim strFolderPath As String
    Dim strCurrentFile As String
    
    If Len(Me.txtFolderPath.Text) = 0 Then Exit Sub 'No folder path provided
    
    'Check if the folder path provided exists
    strFolderPath = Me.txtFolderPath.Text
    If Right(strFolderPath, Len(Application.PathSeparator)) <> Application.PathSeparator Then strFolderPath = strFolderPath & Application.PathSeparator
    If Len(Dir(Me.txtFolderPath.Text)) = 0 Then
        MsgBox "Invalid folder path provided:" & Chr(10) & strFolderPath, , "Invalid Path"
        Exit Sub
    End If
    
    Set wb = ActiveWorkbook
    Set wsData = wb.Sheets("Sheet1")
    Set wsResults = wb.Sheets("Sheet2")
    strCurrentFile = Dir(Me.txtFolderPath.Text & "*.xls*")
    Application.ScreenUpdating = False
    
    'Start a loop to go through each Excel file in the chosen folder path
    Do While Len(strCurrentFile) > 0
        wsData.UsedRange.Clear  'Clear the data worksheet so that the new data can be imported
        'Open the found Excel file
        With Workbooks.Open(strFolderPath & strCurrentFile)
           
            'Populate wsData with the information from the Excel file
            wsData.Range("A1").Resize(.Sheets(1).UsedRange.Rows.Count, .Sheets(1).UsedRange.Columns.Count).Value = .Sheets(1).UsedRange.Value
 

-----------------------------------------------------------------------          
            'Extract desired data to wsResults
            wsResults.Cells(Rows.Count, "A").End(xlUp).Resize(, 3) = Array(wsData.Range("A1").Value, wsData.Range("B3").Value, wsData.Range("D7").Value)
            

-----------------------------------------------------------------------

            .Close False        'Close the opened Excel file, don't save changes
        End With
        strCurrentFile = Dir    'Advance the loop
    Loop
    
    Application.ScreenUpdating = True
    
    Set wb = Nothing
    Set wsData = Nothing
    Set wsResults = Nothing
    
End Sub

The codes independently work OK, but I would like update code 2, replacing the part between "-----" or perhaps more code needs to be altered, such that the code is able to search for a text string in a unknown cell instead of a keyword in a predefined cell. Hence, the code must be able to search through all cells of each loaded file returning the result in sheet 2.

I hope I explained it clearly and I desperately need an answer as I need to run multiple load cased from analysis in the forthcoming week.

Can somebody help me.

Your assistance is greatly appreciated!