VBA Problems selecting visible rows from autofilter

mrMozambique

Board Regular
Joined
Mar 9, 2005
Messages
97
I have some VBA code to filter a column and paste the autofilter results from the first three columns of the range into a second sheet. It then releases the autofilter and repeats the process for a second filtered column (same three columns of the filtered range are copied and pasted into a third sheet). If there are no results in the filtered range, it gives a small message box and continues on to the next procedure. This first procedure is called ANC. Everything seems to work fine in the first block of code.

However, if there are zero results from the second filtering procedure (called LD), it bypasses the message box and selects the entire range (even hidden rows) and the pastes them into my third sheet. The code is the same. I don't understand why the first one works and the second doesn't. Any ideas?


Code:
    Dim rng As Range
    Dim rng2 As Range
    
    'ANC
    wsANC.AutoFilterMode = False
    wsANC.Range("B5:D203").ClearContents
    wsFACILITIES.Range("Clinical").AutoFilter Field:=6, Criteria1:="<>"
    wsFACILITIES.Activate
    wsFACILITIES.AutoFilter.Range.Select
    With ActiveSheet.AutoFilter.Range
     On Error Resume Next
       Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
           .SpecialCells(xlCellTypeVisible)
     On Error GoTo 0
    End With
    If rng2 Is Nothing Then
       MsgBox "No data to copy"
    Else
    Set rng = ActiveSheet.AutoFilter.Range
    rng.Offset(1, 0).Resize(rng.Rows.Count - 1, rng.Columns.Count - 12).Copy
       

        wsANC.Range("B5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        wsFACILITIES.Range("Clinical").AutoFilter Field:=6
    End If
    wsFACILITIES.AutoFilterMode = False
    
    

'LD:
    wsLD.AutoFilterMode = False
    wsLD.Range("B5:D203").ClearContents
    wsFACILITIES.Range("Clinical").AutoFilter Field:=7, Criteria1:="<>"
    wsFACILITIES.Activate
    wsFACILITIES.AutoFilter.Range.Select
    
    With ActiveSheet.AutoFilter.Range
     On Error Resume Next
       Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
           .SpecialCells(xlCellTypeVisible)
     On Error GoTo 0
     MsgBox rng2
    End With
    If rng2 Is Nothing Then
       MsgBox "No data to copy"
    Else
    Set rng = ActiveSheet.AutoFilter.Range
    rng.Offset(1, 0).Resize(rng.Rows.Count - 1, rng.Columns.Count - 12).Copy
        
    
        wsLD.Range("B5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        wsFACILITIES.Range("Clinical").AutoFilter Field:=7
    End If
    wsFACILITIES.AutoFilterMode = False
 

Some videos you may like

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

venkat1926

Well-known Member
Joined
Aug 21, 2005
Messages
4,824
I ahve not fully gone throught your mcro

but after the second filter if you intoduce statementg SOMEWHAT LIKE THIS
it will solve your problem

Code:
if range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Rows.Count=1 then (go to next level in the loop)
 

mrMozambique

Board Regular
Joined
Mar 9, 2005
Messages
97
Venkat, thanks for digging up some old questions without responses. I was able to sort this out. Here's my code if ever anyone needs to borrow.

Code:
' CopyDistricts Macro
'
Answer = MsgBox("This action will OVERWRITE any districts you already have in the program indicator forms.  If you have changed the order of the districts on this sheet and have already entered data in the forms, your data may not correspond to the new district list. Do you want to continue ?", vbYesNo, "Caution!")
If Answer = vbNo Then
    Exit Sub

Else
    
    Application.ScreenUpdating = False
    
    Dim ws As Worksheet
    Dim F As Integer
    Dim rng As Range
    Dim rng2 As Long
    Dim c As Range
    Dim Answer2 As String
    Dim ws2 As Worksheet
    Dim Data As Long
    Dim DataTotal As Long
    
    Data = 0
    DataTotal = 0
    
    For Each ws2 In Worksheets(Array("PP", "SBRP", "CCC", "FOOD"))
            Data = Application.WorksheetFunction.Sum(ws2.Range("F4:CH4"))
            DataTotal = DataTotal + Data
    Next ws2
    
    If DataTotal > 0 Then
        Answer2 = MsgBox("At least one of your facility indicator sheets contains data. This action will overwrite the facilities in your sheet(s).  If you have changed the order of your facilities, your data will not match to the facility.  Do you want to continue ?", vbYesNo, "Caution!")
        If Answer2 = vbNo Then
            Exit Sub
        Else
    
            Set c = wsDISTRICTS.Range("Community")
            F = 3
    
            For Each ws In Worksheets(Array("PP", "SBRP", "CCC", "FOOD"))
            
            If ws.Range("A1").Value = "True" Then
                wsDISTRICTS.Activate
                wsDISTRICTS.Unprotect Password:="budget"
                wsDISTRICTS.AutoFilterMode = False
                ws.Unprotect Password:="budget"
                ws.AutoFilterMode = False
                ws.Range("B5:C203").ClearContents
                c.AutoFilter Field:=F, Criteria1:="Yes"
                rng2 = WorksheetFunction.Subtotal(3, c.Columns(1)) - 1
                wsDISTRICTS.AutoFilter.Range.Select
                    If rng2 = 0 Then
                        'Do Nothing
                    Else
                        Set rng = ActiveSheet.AutoFilter.Range
                        rng.Offset(1, 0).Resize(rng.Rows.Count - 1, rng.Columns.Count - 4).Copy
                        ws.Range("B5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                        Application.CutCopyMode = False
                        
                    End If
                ws.AutoFilterMode = False
                ws.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
                    , AllowFiltering:=True, Password:="budget"
                wsDISTRICTS.AutoFilterMode = False
                wsDISTRICTS.Activate
                wsDISTRICTS.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
                    , AllowFiltering:=True, Password:="budget"
                        
            Else
            'Do nothing and go to next ws
            End If
            F = F + 1
            Next ws
            Application.ScreenUpdating = True
            MsgBox "Congratulations!  Your districts have been copied to all community-based indicator forms.  Please check the forms and contact USG/SI if you notice any problems."
        End If
    End If
End If
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,122,207
Messages
5,594,839
Members
413,943
Latest member
Dhornsby21

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top