CODEWITHSUNDEEP
excelvba
user23357378
user23357378

Reputation: 1

"If Range.EntireRow.Hidden" returning false on one worksheet and true on another when Range is not Hidden

I'm writing code that filters a contiguous array by date, then copies and pastes any visible data to a master sheet. It then loops through all sheets in the workbook, and then loops through all workbooks with "2024" in the title.

For some reason the "If finderr.EntireRow.Hidden = True" statement is only returning a "False" (which activates the copy and paste routine) on the first applicable sheet. Any other worksheet in a workbook after that, even if there are visible rows within the date range, will return 'True" and skip the copy-paste routine.

Sub SalesCopy(strStart As String, strEnd As String, searchfilee As String, finddate As Date)
Dim ws As Worksheet, wsm As Worksheet
Dim wbb As Workbook, wbm As Workbook
Dim finderr As Range
Dim i As Long
Dim shtCount As Long
shtCount = Sheets.Count
Set wbm = Workbooks("Sales & Swap Recs 2024_Test")
Set wsm = wbm.Worksheets("Sale")

For i = 1 To shtCount
        Workbooks(searchfilee).Sheets(i).Activate
        Set finderr = Range(("I2"), Range("I2").End(xlDown))
        finderr.Select
            If Not ActiveSheet.Range("C1") Like "*Date*" Then GoTo SkipSheet
                Sheets(i).Range("C1").AutoFilter Field:=3, _
                                        Criteria1:=">=" & strStart, _
                                        Operator:=xlAnd, _
                                        Criteria2:="<=" & strEnd
            If finderr.EntireRow.Hidden = True Then GoTo SkipSheet
                Range(("B2:O2"), Range("O2").End(xlDown)).SpecialCells(xlCellTypeVisible).Copy
                ActiveSheet.AutoFilterMode = False
                Workbooks("Sales & Swap Recs 2024_Test.xlsm").Activate
                Workbooks("Sales & Swap Recs 2024_Test").Worksheets("Sale").Range("B2").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
SkipSheet:      Application.CutCopyMode = False
            On Error GoTo 0
        Set finderr = Nothing
Next i

I have tried resetting the range variable at the end of each loop to "Set finderr = Nothing" and defining it at the start of each loop. I can confirm this works in the debug tool, as it shows it as "Nothing" at the start of each loop.

After defining the "finderr" range, I use the select function to visually confirm the range has been defined as I expected, which it has. At this point, the unfiltered range "If finderr.EntireRow.Hidden" is classified "false". After executing the Autofilter command, the first page with results returns "false", which activates the copy/paste routine. All other pages, regardless of if they have an unhidden range after autofiltering (ie have the correct dates left unfiltered) return "true" and skip the copy-paste routine.

1st page with filtered results, returning false

1

2nd page with filtered results, returning true

2

Upvotes: 0

Views: 70

Answers (1)

taller
taller

Reputation: 18778

  • Copy/paste operations can be performed without activating the sheet.
  • It's more reliable to qualify all Range/Cells references with the sheet object.
  • If B2 is the last used cell in column B, Range("B2").End(xlDown) will refer to the last cell in the column, which is B1048576 (in M365). Offset(1, 0) raises runtime error.
  • Use oSht.Cells(oSht.Rows.Count, "B").End(xlUp) to locate the last used cell.
  • The source table range (visRange) should be determined before applying the autofilter; otherwise, the range object might be incorrect.

Note: The code isn't tested. Please backup your file before testing.

Option Explicit

Sub SalesCopy(strStart As String, strEnd As String, searchfilee As String, finddate As Date)
    Dim wsm As Worksheet, wbm As Workbook
    Set wbm = Workbooks("Sales & Swap Recs 2024_Test")
    Set wsm = wbm.Worksheets("Sale")
    Dim oSht As Worksheet, visRange As Range, tabRange as Range
    For Each oSht In Workbooks(searchfilee).Worksheets
        Set tabRange = oSht.Range("B2", oSht.Cells(oSht.Rows.Count, "O").End(xlUp))
        Set visRange = Nothing
        If oSht.Range("C1") Like "*Date*" Then
            oSht.Range("C1").AutoFilter Field:=3, Criteria1:=">=" & strStart, Operator:=xlAnd, Criteria2:="<=" & strEnd
            On Error Resume Next
            Set visRange = tabRange.SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not visRange Is Nothing Then
                visRange.Copy
                wsm.Cells(wsm.Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            End If
            oSht.AutoFilterMode = False
            Application.CutCopyMode = False
        End If
    Next oSht
End Sub

Upvotes: 1

Related Questions