Solved

vba code not trapping out null filters

Posted on 2016-10-12
5
48 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 49

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 49

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 49

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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
My experience with Windows 10 over a one year period and suggestions for smooth operation
The viewer will learn how to  create a slide that will launch other presentations in Microsoft PowerPoint. In the finished slide, each item launches a new PowerPoint presentation and when each is finished it automatically comes back to this slide: …
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.

920 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

13 Experts available now in Live!

Get 1:1 Help Now