Results 1 to 14 of 14
  1. #1
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts

    Advanced Filter Macro

    I have set up criteria on sheets (2) "branch1" to sheet (4) in Col J containing the heading "Branch codes"


    I have set up a macro to extract the data from sheets (1) Col A:F based on the criteria on sheet "branch1"

    If I have several branches , then it becomes a time consuming task to write code for each of the sheets

    I would like someone to write code to do the following:

    If "branch codes" appears in Col J on sheets 2 to 4, then extract the data on sheets (1) ("Stock sheets") Col A:F , based on the criteria in Col J on these sheets and to copy the data into A1 onwards on these sheets


    Your assistance in this regard is most appreciated
    Attached Files Attached Files

  2. #2
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,629
    Thanks
    114
    Thanked 644 Times in 588 Posts
    Hi Howard,

    The following code should filter each branch sheet to include records from Stock Sheet whose criteria match those from the Branch sheets. The criteria ranges have been named to match the sheet name (Crit1 for Branch 1, Crit2 for Branch 2, etc.). The Branch sheet records will be sorted to the order of the criteria.

    HTH,
    Maud

    Code:
    Public Sub GetBranch()
    '-----------------------------------------
    'DECLARE AND SET VARIABLES
    Dim wSrc As Worksheet, wDest As Worksheet, CritRng As Range, cell As Range
    Dim ShtNum As Integer, NextRow As Long, EndRow As Long
    Set wSrc = Worksheets("Stock Sheet")
    Lastrow = wSrc.Cells(Rows.Count, 1).End(xlUp).Row
    '-----------------------------------------
    'CYLCE THROUGH SHEETS 2 TO LAST SHEET- GET CRITERIA FOR SHEET
    For ShtNum = 2 To Worksheets.Count
        EndRow = Worksheets(ShtNum).Cells(Rows.Count, 1).End(xlUp).Row + 1
        Set CritRng = Range("Crit" & ShtNum - 1)
    '-----------------------------------------
    'CYCLE THROUGHT CRITERIA CELLS ON BRANCH SHEET
    'MATCH CRITERIA WITH RECORDS ON STOCK SHEET
        For Each cell In CritRng
            For I = 2 To Lastrow
    '-----------------------------------------
    'COPY RECORD TO BRANCH SHEET
                If cell = wSrc.Cells(I, 6) Then
                    Worksheets(ShtNum).Cells(EndRow, 1) = wSrc.Cells(I, 1)
                    Worksheets(ShtNum).Cells(EndRow, 2) = wSrc.Cells(I, 2)
                    Worksheets(ShtNum).Cells(EndRow, 3) = wSrc.Cells(I, 3)
                    Worksheets(ShtNum).Cells(EndRow, 4) = wSrc.Cells(I, 4)
                    Worksheets(ShtNum).Cells(EndRow, 5) = wSrc.Cells(I, 5)
                    Worksheets(ShtNum).Cells(EndRow, 6) = wSrc.Cells(I, 6)
                    EndRow = EndRow + 1
                End If
            Next I
        Next cell
    Next ShtNum
    '-----------------------------------------
    'CLEANUP
    Set WSCR = Nothing
    Set CritRng = Nothing
    Set cell = Nothing
    End Sub
    Attached Files Attached Files

  3. The Following User Says Thank You to Maudibe For This Useful Post:

    HowardC (2016-07-29)

  4. #3
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Hi Maud

    Thanks for the help much appreciated

    I have added code to first clear the data from row 2 onwards on sheets 2 to 4, otherwise each time I select the macro it then copies the data from sheet "Stock Sheets" to sheets to 2 to 4 below the last data based on the criteria for each of these sheets

    However, If I include Clear_Data in macro "GetBranch", it only clears the data and does not extract the data

    Please advise how I can resolve this
    Attached Files Attached Files

  5. #4
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Maud

    I have another workbook, where I have data on sheet "Recon" and want to copy the data from A2:O to sheets 10 onwards except the last sheet based on criteria in Col Q. I have named the criteria on sheets 10 onwards as criteria1, criteria2 etc


    When running the macro, I get runtime error 104 Method "range of object_Global failed"

    and the following code is highlighted

    Code:
     Set CritRng = Range("Crit" & ShtNum - 1)

    I amended your code as follows




    Code:
     Public Sub GetBranch()
    
    '-----------------------------------------
    'DECLARE AND SET VARIABLES
    Dim wSrc As Worksheet, wDest As Worksheet, CritRng As Range, cell As Range
    Dim ShtNum As Integer, NextRow As Long, EndRow As Long
    Set wSrc = Worksheets("Recon")
    Lastrow = wSrc.Cells(Rows.Count, 1).End(xlUp).Row
    
    
    
    '-----------------------------------------
    'CYLCE THROUGH SHEETS 10 TO SECOND LAST SHEET- GET CRITERIA FOR SHEET
    For ShtNum = 10 To Worksheets.Count - 1
        EndRow = Worksheets(ShtNum).Cells(Rows.Count, 1).End(xlUp).Row + 1
        Set CritRng = Range("Crit" & ShtNum - 1)
    '-----------------------------------------
    'CYCLE THROUGHT CRITERIA CELLS ON BRANCH SHEET
    'MATCH CRITERIA WITH RECORDS ON STOCK SHEET
        For Each cell In CritRng
            For I = 2 To Lastrow
    '-----------------------------------------
    
    'COPY RECORD TO BRANCH SHEET
    
    
                If cell = wSrc.Cells(I, 15) Then
                    Worksheets(ShtNum).Cells(EndRow, 1) = wSrc.Cells(I, 1)
                    Worksheets(ShtNum).Cells(EndRow, 2) = wSrc.Cells(I, 2)
                    Worksheets(ShtNum).Cells(EndRow, 3) = wSrc.Cells(I, 3)
                    Worksheets(ShtNum).Cells(EndRow, 4) = wSrc.Cells(I, 4)
                    Worksheets(ShtNum).Cells(EndRow, 5) = wSrc.Cells(I, 5)
                    Worksheets(ShtNum).Cells(EndRow, 6) = wSrc.Cells(I, 6)
                     Worksheets(ShtNum).Cells(EndRow, 7) = wSrc.Cells(I, 7)
                     Worksheets(ShtNum).Cells(EndRow, 8) = wSrc.Cells(I, 8)
                    
                     Worksheets(ShtNum).Cells(EndRow, 9) = wSrc.Cells(I, 9)
                    
                     Worksheets(ShtNum).Cells(EndRow, 10) = wSrc.Cells(I, 10)
                    
                     Worksheets(ShtNum).Cells(EndRow, 11) = wSrc.Cells(I, 11)
                    
                     Worksheets(ShtNum).Cells(EndRow, 12) = wSrc.Cells(I, 12)
                     Worksheets(ShtNum).Cells(EndRow, 13) = wSrc.Cells(I, 13)
                    
                     Worksheets(ShtNum).Cells(EndRow, 14) = wSrc.Cells(I, 14)
                     
                      Worksheets(ShtNum).Cells(EndRow, 15) = wSrc.Cells(I, 15)
                    EndRow = EndRow + 1
                End If
            Next I
        Next cell
    Next ShtNum
    '-----------------------------------------
    'CLEANUP
    Set WSCR = Nothing
    Set CritRng = Nothing
    Set cell = Nothing
    End Sub
    It would be appreciated if you could kindly assist me

  6. #5
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,629
    Thanks
    114
    Thanked 644 Times in 588 Posts
    Howard,

    Nice coding! Note the lines in blue to clear the branch sheets from within the GetBranch macro. I also added the With statement.

    I would keep your code to only clear the contents of the branch sheets which is launched by a button labeled reset.

    HTH,
    Maud

    Code:
    Public Sub GetBranch()
    '-----------------------------------------
    'DECLARE AND SET VARIABLES
    Dim wSrc As Worksheet, wDest As Worksheet, CritRng As Range, cell As Range
    Dim ShtNum As Integer, NextRow As Long, EndRow As Long
    Set wSrc = Worksheets("Stock Sheet")
    Lastrow = wSrc.Cells(Rows.Count, 1).End(xlUp).Row
    '-----------------------------------------
    'CYLCE THROUGH SHEETS 2 TO LAST SHEET- GET CRITERIA FOR SHEET
    For ShtNum = 2 To Worksheets.Count
        With Worksheets(ShtNum)
            EndRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            .Range("A2:F" & EndRow).ClearContents
            EndRow = 2
            Set CritRng = Range("Crit" & ShtNum - 1)
    '-----------------------------------------
    'CYCLE THROUGHT CRITERIA CELLS ON BRANCH SHEET
    'MATCH CRITERIA WITH RECORDS ON STOCK SHEET
            For Each cell In CritRng
                For I = 2 To Lastrow
    '-----------------------------------------
    'COPY RECORD TO BRANCH SHEET
                    If cell = wSrc.Cells(I, 6) Then
                        .Cells(EndRow, 1) = wSrc.Cells(I, 1)
                        .Cells(EndRow, 2) = wSrc.Cells(I, 2)
                        .Cells(EndRow, 3) = wSrc.Cells(I, 3)
                        .Cells(EndRow, 4) = wSrc.Cells(I, 4)
                        .Cells(EndRow, 5) = wSrc.Cells(I, 5)
                        .Cells(EndRow, 6) = wSrc.Cells(I, 6)
                        EndRow = EndRow + 1
                    End If
                Next I
            Next cell
        End With
    Next ShtNum
    '-----------------------------------------
    'CLEANUP
    Set WSCR = Nothing
    Set CritRng = Nothing
    Set cell = Nothing
    End Sub
    Last edited by Maudibe; 2016-07-30 at 01:14.

  7. #6
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,629
    Thanks
    114
    Thanked 644 Times in 588 Posts
    Howard,

    To answer post #4, you need to change that line to:

    Code:
     Set CritRng = Range("criteria" & ShtNum - 1)
    Maud

  8. #7
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Thanks Maud

    Code works perfectly

  9. #8
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Hi Maud

    I still can't get the code per my post #4 to work. I still get run time error 1004 Method "range of object_Global failed"

    I have attached the sample file


    It would be appreciated if you can correct and advise where I went wrong
    Attached Files Attached Files

  10. #9
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,815
    Thanks
    132
    Thanked 479 Times in 456 Posts
    Hi Howard

    I just made a minor tweak to the code you and Maud did.
    You could try this:
    Code:
    Public Sub GetBranch()
    '-----------------------------------------
    'DECLARE AND SET VARIABLES
    Dim wSrc As Worksheet, wDest As Worksheet, CritRng As Range, cell As Range
    Dim branch As Integer, NextRow As Long, EndRow As Long
    Set wSrc = Worksheets("Stock Sheet")
    Lastrow = wSrc.Cells(Rows.Count, 1).End(xlUp).Row
    '-----------------------------------------
    'LOOP THROUGH [Br ] SHEETS - GET CRITERIA FOR SHEET
    For branch = 1 To 6
        With Worksheets("Br" & branch)                          'e.g. Br1,Br2,..,Br6
            EndRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            .Range("A2:F" & EndRow).ClearContents
            EndRow = 2
            Set CritRng = Range("Crit" & branch)                'e.g. Crit1,Crit2,..,Crit6
    '-----------------------------------------
    'CYCLE THROUGHT CRITERIA CELLS ON BRANCH SHEET
    'MATCH CRITERIA WITH RECORDS ON STOCK SHEET
            For Each cell In CritRng
                For i = 2 To Lastrow
    '-----------------------------------------
    'COPY RECORD TO BRANCH SHEET
                    If cell = wSrc.Cells(i, 15) Then
                        .Cells(EndRow, 1) = wSrc.Cells(i, 1)
                        .Cells(EndRow, 2) = wSrc.Cells(i, 2)
                        .Cells(EndRow, 3) = wSrc.Cells(i, 3)
                        .Cells(EndRow, 4) = wSrc.Cells(i, 4)
                        .Cells(EndRow, 5) = wSrc.Cells(i, 5)
                        .Cells(EndRow, 6) = wSrc.Cells(i, 6)
                        .Cells(EndRow, 6) = wSrc.Cells(i, 6)
                         .Cells(EndRow, 7) = wSrc.Cells(i, 7)
                        .Cells(EndRow, 8) = wSrc.Cells(i, 8)
                        .Cells(EndRow, 9) = wSrc.Cells(i, 9)
                        .Cells(EndRow, 10) = wSrc.Cells(i, 10)
                        .Cells(EndRow, 11) = wSrc.Cells(i, 11)
                         .Cells(EndRow, 12) = wSrc.Cells(i, 12)
                        .Cells(EndRow, 13) = wSrc.Cells(i, 13)
                        .Cells(EndRow, 14) = wSrc.Cells(i, 14)
                        .Cells(EndRow, 15) = wSrc.Cells(i, 15)
                      
                        
                        
                        EndRow = EndRow + 1
                    End If
                Next i
            Next cell
        End With
    Next branch                                          '<< changed
    '-----------------------------------------
    'CLEANUP
    Set WSCR = Nothing
    Set CritRng = Nothing
    Set cell = Nothing
    End Sub

    NOTE:
    The code in your posted file included:
    .Cells(EndRow, 14) = wSrc.Cells(i, 14)
    .Cells(EndRow, 14) = wSrc.Cells(i, 15)

    I assume this was a typo, so I changed it to..
    .Cells(EndRow, 14) = wSrc.Cells(i, 14)
    .Cells(EndRow, 15) = wSrc.Cells(i, 15)

    zeddy
    Last edited by zeddy; 2016-07-30 at 06:58.

  11. The Following User Says Thank You to zeddy For This Useful Post:

    HowardC (2016-07-30)

  12. #10
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Hi Zeddy

    The data is filtering all the data from sheet "Recon" to sheet BR1 and no data is filtered to the other BR sheets

    I have attached the workbook

    Please test & amend the code
    Attached Files Attached Files

  13. #11
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,815
    Thanks
    132
    Thanked 479 Times in 456 Posts
    Hi Howard

    ..see attached file.
    I changed the routine from Sub GetBranch() to this routine:
    Code:
    Sub filterReconToBranch()
    
    Application.ScreenUpdating = False                  'freeze display for speedup
    
    Set zSource = Sheets("Recon").[a1].CurrentRegion    'define data range for filter
    
    For branch = 1 To 6                                 'loop for 6 Banches
    Sheets("Br" & branch).[a1].CurrentRegion.Offset(1).ClearContents    'clear data beneath heading row
    'fetch data from named range into an array..
    zArray = Range("Crit" & branch)                     'e.g. Crit1,Crit2,..,Crit6;
    zArray = Application.Transpose(zArray)              'convert data from 'down' to 'across'
    zSource.AutoFilter Field:=[H1].Column, Criteria1:=zArray, Operator:=xlFilterValues
    Sheets("Recon").AutoFilter.Range.Copy Sheets("Br" & branch).[a1]    'filter and copy data to [Br ] sheet
    Next branch                                         'process next Branch
    
    Sheets("Recon").AutoFilterMode = False              'clear all filters on [Recon] sheet
    
    End Sub
    ..just a different way of doing what you want?

    zeddy
    Attached Files Attached Files

  14. The Following User Says Thank You to zeddy For This Useful Post:

    HowardC (2016-07-30)

  15. #12
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Hi Zeddy

    Thanks very much for the help. The code works perfectly

    Say for eg branch names are KTL PA, KTL UIT, KTL CPT etc i.e spaces in the branch name, how to I amend the code below, which I guess is all I need to change if all the other parameters remain the same

    Code:
     Sheets("Br" & branch).[a1].CurrentRegion.Offset(1).ClearContents
    I tried changing this to

    Code:
     Sheets("KTL" & branch).[a1].CurrentRegion.Offset(1).ClearContents
    When changing this I get a run time error

    "The item with the specified name was not found"

    Please advise on how to resolve this

  16. #13
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,629
    Thanks
    114
    Thanked 644 Times in 588 Posts
    Howard,

    Here is your Recon workbook corrected.

    Maud
    Attached Files Attached Files

  17. The Following User Says Thank You to Maudibe For This Useful Post:

    HowardC (2016-07-30)

  18. #14
    Bronze Lounger
    Join Date
    Feb 2008
    Posts
    1,420
    Thanks
    124
    Thanked 5 Times in 5 Posts
    Thanks very much Maud. Code works perfectly

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •