Solved

Searching multiple excel spreadsheets

Posted on 2013-11-21
4
169 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 29

Expert Comment

by:gowflow
Comment Utility
Do you still need help on this one ?
gowflow
0
 
LVL 32

Expert Comment

by:Robberbaron (robr)
Comment Utility
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
Comment Utility
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 500 total points
Comment Utility
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

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

728 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

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now