vba code not trapping out null filters

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
DAVID131Asked:
Who is Participating?

Improve company productivity with a Business Account.Sign Up

x
Advertise Here
 
Rgonzo1971Connect With a Mentor Commented:
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
 
Rgonzo1971Commented:
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
 
DAVID131Author Commented:
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
 
DAVID131Author Commented:
Thanks for this - the code now copes with several null scenarios

Could you explain why the original code was not working
0
 
Rgonzo1971Commented:
like I said the first row was not reinitialized (it was assuming data in the filter)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.