Quantcast
Channel: Active questions tagged excel - Stack Overflow
Viewing all articles
Browse latest Browse all 88030

Search all files in folder for numerous strings

$
0
0

I have a folder with password protected workbooks (same password) for all the branches in our company, Liverpool, Manchester etc.

In each workbook is a simple table that shows sales data, a sales number, name, email address, stock code etc, sometimes on 3 worksheets in each workbook

I then have a master workbook that has a list of stock codes in it.

I need to be able to create a macro that searches through all of the workbooks in row F and if it finds a matching value for any of the stockcodes, copy that row and paste it to a new worksheet in the master workbook with the title of the worksheet being the same name as the file name it found it in, with the rows of data throughout.

I had something similar that searched for one key phrase and returned a row, but i need it to search for any string from an entire row of strings.

Sub STBP()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWS As Worksheet, wkbSource As Workbook, response As String, LastRow As Long
    Set desWS = ThisWorkbook.Sheets("Sales to be Processed")
    response = InputBox("Please enter the search string.")
    If response = "" Then Exit Sub
    Const strPath As String = "C:\Users\marc.delaney\Documents\TestSave\"'change folder path to suit your needs
    ChDir strPath
    strExtension = Dir(strPath & "*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            LastRow = desWS.Range("C"& Rows.Count).End(xlUp).Row
            Set srcWS = .Sheets("Sales To Be Processed")
            srcWS.Unprotect Password:="cgeod18"
            With srcWS.Cells(7, 2).CurrentRegion
                .AutoFilter Field:=12, Criteria1:="=*"& response & "*"
                desWS.Range("A"& LastRow + 1) = wkbSource.Name
                srcWS.AutoFilter.Range.Offset(1, 0).Copy desWS.Cells(desWS.Rows.Count, "B").End(xlUp).Offset(1, 0)
            End With
            .Close SaveChanges:=False
        End With
        strExtension = Dir
    Loop
    Columns.AutoFit
    Application.ScreenUpdating = True
 End Sub

Viewing all articles
Browse latest Browse all 88030

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>