Solved

vba code not trapping out null filters

Posted on 2016-10-12
5
39 Views
Last Modified: 2016-10-17
1. I have a model in which a macro performs 3 successive filters in sequence and has worked ok for 2 months. see attach #1
However, for the first time, the input data now contains null entries
2. If the cells for the first filter are blank the macro still performs as intended see attach #2  (sheet 01)
3. If the cells for the first filter are populated but the second filter (sheet 02) produces a blank row, the filter header is reported in the up1 sheet. see attach #3
4. If the cells for the first filter are not populated and the second filter (sheet 02) produces a blank row - I get a run time error 1004 see attach #4

Could someone advise why the null field is being trapped out in attach #2 but not in #3 and #4

The arrangement of the rows/columns cannot be altered
EE-null-filter-issue--1.xlsm
EE-null-filter-issue--2.xlsm
EE-null-filter-issue--3.xlsm
EE-null-filter-issue--4.xlsm
0
Comment
Question by:DAVID131
  • 3
  • 2
5 Comments
 
LVL 48

Expert Comment

by:Rgonzo1971
ID: 41839854
Hi,

pls try

'APPLY 3 FILTERS
Sub Three_filters_argument(ws As Worksheet)
'
' three_filters Macro
'
'PERFORM FIRST FILTER

'switch off auto calcs to speed up code

Application.Calculation = xlCalculationManual

    ws.Select
   
    If ActiveSheet.AutoFilterMode = True Then
    Selection.AutoFilter
    End If
    
    xrow = Range("V999999").End(xlUp).Row
    
    Range("V5").Select
    Selection.AutoFilter
    ActiveSheet.Range("$V$5:$z$" & xrow).AutoFilter field:=1, Criteria1:=">1", Operator:=xlAnd
    
    Set filteredrange = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    
'if header row or blank exclude otherwise copy visible rows

    headerrow = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas(1).Row
    flag = 0
    For Each rngrow In filteredrange.Rows
    lastrow = rngrow.Row
    If rngrow.Hidden = False And rngrow.Row <> headerrow And flag = 0 Then
    flag = 1
    firstrow = rngrow.Row
    End If
    Next
    If firstrow > 0 Then
    Range("V" & firstrow & ":Z" & lastrow).Select
    Selection.Copy
   
Sheets("up1").Select

    If Range("B2").Value = "" Then
    Range("B2").Select
    Else
    Range("B1").End(xlDown).Offset(1, 0).Select
    End If
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
Range("A1").Select
   
    End If
    
    'PERFORM SECOND FILTER
    
 
    ws.Select
    
    
  
    If ActiveSheet.AutoFilterMode = True Then
    Selection.AutoFilter
    End If
    
    xrow = Range("AA999999").End(xlUp).Row
    
    Range("AA5").Select
    Selection.AutoFilter
    ActiveSheet.Range("$AA$5:$AE$" & xrow).AutoFilter field:=2, Criteria1:=">1", Operator:=xlAnd
    
    Set filteredrange = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    
    headerrow = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas(1).Row
    flag = 0
    firstrow = 0
    For Each rngrow In filteredrange.Rows
    lastrow = rngrow.Row
    If rngrow.Hidden = False And rngrow.Row <> headerrow And flag = 0 Then
    flag = 1
    firstrow = rngrow.Row
    End If
    Next
    If firstrow > 0 Then
    Range("AA" & firstrow & ":AE" & lastrow).Select
    Selection.Copy
   
Sheets("up1").Select
    If Range("B2").Value = "" Then
    Range("B2").Select
    Else
    Range("B1").End(xlDown).Offset(1, 0).Select
    End If
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
Range("A1").Select
    End If
    
    'PERFORM THIRD FILTER 7 TIMES i.e each copied set into absolute upload is equivalent to one day
    
    Dim x
   
    ws.Select
    
    If ActiveSheet.AutoFilterMode = True Then
    Selection.AutoFilter
    End If
    
    xrow = Range("AG999999").End(xlUp).Row
    
    Range("AG5").Select
    Selection.AutoFilter
    ActiveSheet.Range("$AG$5:$AH$" & xrow).AutoFilter field:=1, Criteria1:=">1", Operator:=xlAnd
    
    Set filteredrange = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    
    headerrow = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas(1).Row
    flag = 0
    firstrow = 0
    For Each rngrow In filteredrange.Rows
    lastrow = rngrow.Row
    If rngrow.Hidden = False And rngrow.Row <> headerrow And flag = 0 Then
    flag = 1
    firstrow = rngrow.Row
    End If
    Next
  
   
    If firstrow > 0 Then
        If ws.Cells(firstrow, "AG") <> "" Then
   

        Range("AG" & firstrow & ":AH" & lastrow).Select
    
        Let x = 0
        Do While x < 7
    
            Selection.Copy
   
Sheets("up2").Select
            If Range("A2").Value = "" Then
                Range("A2").Select
            Else
   
            Range("A1").End(xlDown).Offset(1, 0).Select
            End If
    
    
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
    
            x = x + 1
        Loop
    
    Range("a1").Select
        End If
    End If
    Application.Calculation = xlCalculationAutomatic
    
End Sub

Open in new window

Regards
0
 

Author Comment

by:DAVID131
ID: 41840349
Thanks for the quick response
I almost thought you had the solution but I double checked with another scenario and found the header "bottom" being pulled through into the up1 sheet
Any ideas?
I would appreciate if you can tell me (in lay terms) what I did wrong in the original code
EE-null-filter-issue--5.xlsm
0
 
LVL 48

Accepted Solution

by:
Rgonzo1971 earned 500 total points
ID: 41840469
the code here

I reinitialize firstrow to 0 before filtering it (line 78 and 124)
'APPLY 3 FILTERS
Sub Three_filters_argument(ws As Worksheet)
'
' three_filters Macro
'
'PERFORM FIRST FILTER

'switch off auto calcs to speed up code

Application.Calculation = xlCalculationManual

    ws.Select
   
    If ActiveSheet.AutoFilterMode = True Then
    Selection.AutoFilter
    End If
    
    xrow = Range("V999999").End(xlUp).Row
    
    Range("V5").Select
    Selection.AutoFilter
    ActiveSheet.Range("$V$5:$z$" & xrow).AutoFilter field:=1, Criteria1:=">1", Operator:=xlAnd
    
    Set filteredrange = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    
'if header row or blank exclude otherwise copy visible rows

    headerrow = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas(1).Row
    flag = 0
    For Each rngrow In filteredrange.Rows
    lastrow = rngrow.Row
    If rngrow.Hidden = False And rngrow.Row <> headerrow And flag = 0 Then
    flag = 1
    firstrow = rngrow.Row
    End If
    Next
    If firstrow > 0 Then
    Range("V" & firstrow & ":Z" & lastrow).Select
    Selection.Copy
   
Sheets("up1").Select

    If Range("B2").Value = "" Then
    Range("B2").Select
    Else
    Range("B1").End(xlDown).Offset(1, 0).Select
    End If
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
Range("A1").Select
   
    End If
    
    'PERFORM SECOND FILTER
    
 
    ws.Select
    
    
  
    If ActiveSheet.AutoFilterMode = True Then
    Selection.AutoFilter
    End If
    
    xrow = Range("AA999999").End(xlUp).Row
    
    Range("AA5").Select
    Selection.AutoFilter
    ActiveSheet.Range("$AA$5:$AE$" & xrow).AutoFilter field:=2, Criteria1:=">1", Operator:=xlAnd
    
    Set filteredrange = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    
    headerrow = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas(1).Row
    flag = 0
    firstrow = 0
    For Each rngrow In filteredrange.Rows
    lastrow = rngrow.Row
    If rngrow.Hidden = False And rngrow.Row <> headerrow And flag = 0 Then
    flag = 1
    firstrow = rngrow.Row
    End If
    Next
    If firstrow > 0 Then
    Range("AA" & firstrow & ":AE" & lastrow).Select
    Selection.Copy
   
Sheets("up1").Select
    If Range("B2").Value = "" Then
    Range("B2").Select
    Else
    Range("B1").End(xlDown).Offset(1, 0).Select
    End If
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
Range("A1").Select
    End If
    
    'PERFORM THIRD FILTER 7 TIMES i.e each copied set into absolute upload is equivalent to one day
    
    Dim x
   
    ws.Select
    
    If ActiveSheet.AutoFilterMode = True Then
    Selection.AutoFilter
    End If
    
    xrow = Range("AG999999").End(xlUp).Row
    
    Range("AG5").Select
    Selection.AutoFilter
    ActiveSheet.Range("$AG$5:$AH$" & xrow).AutoFilter field:=1, Criteria1:=">1", Operator:=xlAnd
    
    Set filteredrange = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    
    headerrow = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas(1).Row
    flag = 0
    firstrow = 0
    For Each rngrow In filteredrange.Rows
    lastrow = rngrow.Row
    If rngrow.Hidden = False And rngrow.Row <> headerrow And flag = 0 Then
    flag = 1
    firstrow = rngrow.Row
    End If
    Next
  
   
    'If firstrow > 0 And ws.Cells(firstrow, "AG") <> "" Then
   If firstrow > 0 Then
   If ws.Cells(firstrow, "AG") <> "" Then

    Range("AG" & firstrow & ":AH" & lastrow).Select
    
    Let x = 0
    Do While x < 7
    
    Selection.Copy
   
Sheets("up2").Select
    If Range("A2").Value = "" Then
    Range("A2").Select
    Else
   
    Range("A1").End(xlDown).Offset(1, 0).Select
    End If
    
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    x = x + 1
    Loop
    
    Range("a1").Select
    End If
    
    End If
    
    Application.Calculation = xlCalculationAutomatic
    
End Sub

Open in new window

0
 

Author Comment

by:DAVID131
ID: 41841497
Thanks for this - the code now copes with several null scenarios

Could you explain why the original code was not working
0
 
LVL 48

Expert Comment

by:Rgonzo1971
ID: 41841518
like I said the first row was not reinitialized (it was assuming data in the filter)
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Suggested Solutions

This article will show you how to use shortcut menus in the Access run-time environment.
In this article we discuss how to recover the missing Outlook 2011 for Mac data like Emails and Contacts manually.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

743 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

14 Experts available now in Live!

Get 1:1 Help Now