Searching multiple excel spreadsheets

Currenly i have the below code that searches the worksheet for text and outputs it on anouther tab.

What I would like to do is for it to search external spreadsheets saving me copying and pasting the information into the one spreadhseet each time a month goes by.

Sub Test()
       
       Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim copyFrom As Range
    Dim lRow As Long '<~~ Not Integer. Might give you error in higher versions of excel
    Dim strSearch As String

    Set wb1 = ThisWorkbook
   ' Application.Workbooks.Open("C:\Sample.xlsx")
    Set ws1 = wb1.Worksheets("FCA")

    strSearch = ActiveSheet.inputname.Text



    With ws1

        '~~> Remove any filters
        .AutoFilterMode = False

        lRow = .Range("G" & .Rows.Count).End(xlUp).Row

        With .Range("G1:l" & lRow)
            .AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"
            Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
        End With

        '~~> Remove any filters
        .AutoFilterMode = False
    End With

    '~~> Destination File
    Set ws2 = wb1.Worksheets("Output")

    With ws2
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            lRow = .Cells.Find(What:="*", _
                          After:=.Range("G1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row + 1
        Else
            lRow = 1
        End If

        copyFrom.Copy .Rows(lRow)
    End With


End Sub

Open in new window


The names will look like this

11 FactCauseAction - November 2013.xls
12 FactCauseAction - December 2013.xls
runnerjp2005Asked:
Who is Participating?

Improve company productivity with a Business Account.Sign Up

x
 
Robberbaron (robr)Connect With a Mentor Commented:
1/ if you dont delete or move the files, how will the application know which ones have been processed. or it could every month, evrry time ?

2/ where will each output be saved ??? to  a named sheet in current workbook ?

2/ you need to wrap the code i indicated around your process.... see the part 'do wahtever.

Sub Test()
       
    Dim wbTmp As Workbook, wb2 As Workbook
    Dim wsTmp As Worksheet, wsOut As Worksheet
    Dim strSearch As String


    '~~> Destination File
    Set wsOut = ActiveWorkbook.Worksheets("Output")
    
    strSearch = ActiveSheet.inputname.Text

    Dim fl As String
    fl = Dir$("FactCauseAction - *.xls")
    Do While fl <> ""
    
        Set wbTmp = Workbooks.Add(fl)
        'do whatever to wb2
    
            Set wsTmp = wbTmp.Worksheets("FCA")
            ProcessWorksheet ws1, wsOut, strSearch
            '<<<?? move to location to save the second lot of output....
        wb2.Close
        'Kill fl  '<<<?delete the file once finished, or move it out of processing area
        fl = Dir$  'get next file in series
    Loop

    

End Sub

Sub ProcessWorksheet(wsIn As Worksheet, wsOut As Worksheet, strSearch As String)
    Dim lRow As Long
    Dim copyFrom As Range


    With wsIn

        '~~> Remove any filters
        .AutoFilterMode = False

        lRow = .Range("G" & .Rows.Count).End(xlUp).Row

        With .Range("G1:l" & lRow)
            .AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"
            Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
        End With

        '~~> Remove any filters
        .AutoFilterMode = False
    End With



    With wsOut
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            lRow = .Cells.Find(What:="*", _
                          After:=.Range("G1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row + 1
        Else
            lRow = 1
        End If

        copyFrom.Copy Destination:=.Rows(lRow)
    End With

End Sub

Open in new window

0
 
gowflowCommented:
Do you still need help on this one ?
gowflow
0
 
Robberbaron (robr)Commented:
i would use the Dir$ function

dim fl as string
fl = dir$("FactCauseAction - *.xls")
do while fl <> ""

    set wb2 = workbooks.add(fl)
    'do whatever to wb2
    wb2.close
    kill fl  'delete the file once finished, or move it out of processing area
    fl = dir$  'get next file in series
loop

Open in new window

0
 
runnerjp2005Author Commented:
yes i still need help :)


where would i add the dir function in my current code? - also i dont want to delete any files!!!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.