For Loop to Copy/Paste Table Data Not Working

[z3115]

Hey All, I have the following piece of code that is part of a larger macro. This piece basically cycles through some sheets, filters them, and copy/pastes the filtered data onto a summary sheet.

It should NOT copy/paste the headers from each worksheet, just the data. It works OK except when the table is empty (i.e. only has the headers, no other data). In that case it copies the headers over to the summary sheet.

Any guesses as to why this might be happening or how to fix it? Thank you!

For Each Ws In Worksheets
        If Not UBound(Filter(Ary, Ws.Name, True, vbTextCompare)) >= 0 Then
            If Ws.Visible = xlSheetVisible Then
            'Make the column used in the line below a column that should never be blank. Code used it to determine what the last non-empty row is.
            UsdRws = Ws.Range("F" & Rows.Count).End(xlUp).Row
            If Ws.AutoFilterMode Then Ws.AutoFilterMode = False
            
            'check if "all" is selected:
            On Error Resume Next
            If Ans <> "All" Then
            'line below: parts in double quotes turn it from an = criteria to a contains criteria
            Ws.Range("A1").AutoFilter field:=12, Criteria1:="=*" & Ans & "*"
            End If
            'optional filters:
            If Range("fc_1").Value = 2 Then
            Ws.Range("A1").AutoFilter field:=1, Criteria1:=Ans2 'Filter on key dates if only pulling key dates
            End If
            If Range("fc_1").Value = 3 Then
            Ws.Range("A1").AutoFilter field:=2, Criteria1:=Ans2
            End If
             If Range("fc_1").Value = 4 Then
            Ws.Range("A1").AutoFilter field:=3, Criteria1:=Ans2
            End If
            
            On Error Resume Next
            Ws.Range("A2:A" & UsdRws).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
                OSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
            On Error GoTo 0
            Ws.Range("A1").AutoFilter
        End If
        End If
    Next Ws

 

[PatOBrien198]

try checking the value of UsdRws right before the copy statement.... perhaps if it is < 2 then don't do the copy.

 

[z3115]

Got it! Was trying with UsdRws > 0 (should have been 1, or less than 2 as you stated), Thanks! I figured I was missing something obvious

try checking the value of UsdRws right before the copy statement.... perhaps if it is < 2 then don't do the copy.

 

[Fluff]

Maybe

   On Error Resume Next
   With Range("A2:A" & usdrws).SpecialCells(xlCellTypeVisible)
      If .CountLarge > 1 Then .EntireRow.Copy OSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
   End With
   On Error GoTo 0

 

[Fluff]

Got it! Was trying with UsdRws > 0 (should have been 1, or less than 2 as you stated), Thanks! I figured I was missing something obvious

Bearing in mind that you are assigning a value to UsdRws before applying the filter, that method may not be very reliable

 

[z3115]

Thanks Fluff, that's a good point. The only thing that is odd is that the macro was working fine before on sheets that had 0 visible rows after filtering, as long as they had more than just the header initially. I don't know why this was the case though.

Bearing in mind that you are assigning a value to UsdRws before applying the filter, that method may not be very reliable