[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Searching multiple excel spreadsheets

Posted on 2013-11-21
4
Medium Priority
?
219 Views
Last Modified: 2013-12-13
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
0
Comment
Question by:runnerjp2005
  • 2
4 Comments
 
LVL 31

Expert Comment

by:gowflow
ID: 39673157
Do you still need help on this one ?
gowflow
0
 
LVL 32

Expert Comment

by:Robberbaron (robr)
ID: 39674438
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
 

Author Comment

by:runnerjp2005
ID: 39683031
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
 
LVL 32

Accepted Solution

by:
Robberbaron (robr) earned 2000 total points
ID: 39683497
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

Featured Post

Get free NFR key for Veeam Availability Suite 9.5

Veeam is happy to provide a free NFR license (1 year, 2 sockets) to all certified IT Pros. The license allows for the non-production use of Veeam Availability Suite v9.5 in your home lab, without any feature limitations. It works for both VMware and Hyper-V environments

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

New style of hardware planning for Microsoft Exchange server.
Microsoft has changed the look and feel of Azure AD and Microsoft account sign-in pages so that you will have a more unified look and feel when moving between the two interfaces.
Do you want to know how to make a graph with Microsoft Access? First, create a query with the data for the chart. Then make a blank form and add a chart control. This video also shows how to change what data is displayed on the graph as well as form…
In this video you will find out how to export Office 365 mailboxes using the built in eDiscovery tool. Bear in mind that although this method might be useful in some cases, using PST files as Office 365 backup is troublesome in a long run (more on t…

829 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question