VBA Problems selecting visible rows from autofilter

[mrMozambique]

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?

    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

 

[venkat1926]

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

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

 

[mrMozambique]

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.

' 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