Solved

vba code not trapping out null filters

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

Live: Real-Time Solutions, Start Here

Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.

Question has a verified solution.

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

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

785 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