Print sheets based on filtered results from multiple workbooks

Lungfish

New Member
Joined
Aug 5, 2011
Messages
6
Hi all.
I have a macro that looks through workbooks in a folder and searches column A in sheet 1 for results that meet a criteria. When it finds a result, the macro will copy the entire corresponding row into a new workbook and continue searching for more matching results.
Each workbook in the folder has a main sheet (sheet1) that has 17 rows (jobs). Each row(job) has an associated checklist on another sheet (sheets 2-18).

At the moment I run the filter macro to get the list of "jobs" that meet the filter criteria.
I then manually have to go back through all the workbooks in the folder to print the associated checklists.

Is there a way to add/run a print macro to print the associated checklists as the filter macro finds a result?

Any help will be greatly appreciated.
Regards,
Martin

Code:
Sub Filter_Job_Checklists()
    Dim myFiles As Variant
    Dim myCountOfFiles As Long

    myCountOfFiles = Get_File_Names( _
                     MyPath:="C:\filepath", _
                     Subfolders:=False, _
                     ExtStr:="JOB CHECKLIST*.xlsm", _
                     myReturnedFiles:=myFiles)

    If myCountOfFiles = 0 Then
        MsgBox "No files that match the ExtStr in this folder"
        Exit Sub
    End If

    Get_Filter _
            FileNameInA:=False, _
            SourceShName:="", _
            SourceShIndex:=1, _
            FilterRng:="A1:W" & Rows.Count, _
            FilterField:=1, _
            FilterValue1:="<6", _
            myReturnedFiles:=myFiles
     
End Sub

'Macro to find values (FilterValue 1) in the Job Checklists contained in the folder.

Sub Get_Filter(FileNameInA As Boolean, SourceShName As String, _
               SourceShIndex As Integer, FilterRng As String, FilterField As Integer, _
               FilterValue1 As String, myReturnedFiles As Variant)
    Dim SourceRange As Range, destrange As Range
    Dim mybook As Workbook, BaseWks As Worksheet
    Dim rnum As Long, CalcMode As Long
    Dim SourceSh As Variant
    Dim rng As Range
    Dim RwCount As Long
    Dim I As Long
    Dim z As Long
    Dim vHdr As Variant
    Dim Counter As Integer
    Dim lastCell As String
    Dim LC As Range
    Dim x As Long
    Dim lastC As Range
    Dim LR As Long
    Dim OutApp As Object
    Dim OutMail As Object

    'Change ScreenUpdating, Calculation and EnableEvents
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Open new workbook and add one sheet 
    Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    BaseWks.Name = "1"
    'Set start row for the Data
    rnum = 1

    'Check if we use a named sheet or the Sheet index
    If SourceShName = "" Then
        SourceSh = SourceShIndex
    Else
        SourceSh = SourceShName
    End If

    'Loop through all files in the array of found files(myFiles)
    For I = LBound(myReturnedFiles) To UBound(myReturnedFiles)
        Set mybook = Nothing
        On Error Resume Next
        Set mybook = Workbooks.Open(myReturnedFiles(I))
        On Error GoTo 0

        If Not mybook Is Nothing Then

            'Set SourceRange and check if it is a valid range
            On Error Resume Next

            With mybook.Sheets(SourceSh)
                Set SourceRange = Application.Intersect(.UsedRange, .Range(FilterRng))
            End With

            If Err.Number > 0 Then
                Err.Clear
                Set SourceRange = Nothing
            Else
                'If SourceRange use all columns then skip this file
                If SourceRange.Columns.Count >= BaseWks.Columns.Count Then
                    Set SourceRange = Nothing
                End If
            End If
            On Error GoTo 0

            If Not SourceRange Is Nothing Then

                'Find the last row in BaseWks
                rnum = RDB_Last(1, BaseWks.Cells) + 1

                With SourceRange.Parent
                    Set rng = Nothing

                    'Firstly, remove the AutoFilter
                    .AutoFilterMode = False

                    'Filter the range on the FilterField column (Weeks to Go)
                    SourceRange.AutoFilter Field:=FilterField, _
                                        Criteria1:=FilterValue1
                  
                    With .AutoFilter.Range
                        'Check if there are results after you use AutoFilter
                        RwCount = .Columns(1).Cells. _
                                  SpecialCells(xlCellTypeVisible).Cells.Count - 1

                        If RwCount = 0 Then
                            'There is no data, only the header
                        Else
                            'Set a range without the Header row
                            Set rng = .Resize(.Rows.Count + 1, .Columns.Count). _
                                      Offset(1, 0).SpecialCells(xlCellTypeVisible)

                            If FileNameInA = True Then
                                'Copy the range and the file name
                                If rnum + RwCount < BaseWks.Rows.Count Then
                                    BaseWks.Cells(rnum, "A").Resize(RwCount).Value _
                                          = mybook.Name
                                    rng.Copy BaseWks.Cells(rnum, "B")
                                End If
                            Else
                                'Copy the range
                                If rnum + RwCount < BaseWks.Rows.Count Then
                                    rng.Copy BaseWks.Cells(rnum, "A")
                                End If
                            End If
                        End If
                    End With

                    'Remove the AutoFilter
                    .AutoFilterMode = False

                End With
            End If

            'Close the "JOB CHECKLIST *" without saving
            mybook.Close savechanges:=False
        End If

        'Open the next workbook
    Next I
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.

Forum statistics

Threads
1,224,587
Messages
6,179,740
Members
452,940
Latest member
Lawrenceiow

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top