Hiding Rows With past Dates Automatically When Opening the Workbook

[nryan]

Hi all,

I want to hide rows based on a timestamp in column A. If the timestamp is a day old, hide the row. The code below used to work great but I just updated the workbook and the problem is that the code is only working for one of the worksheets (past date rows are hidden), while the other 4 are unaffected (past date rows not hidden).

Sub Workbook_Open()

    Dim ws As Worksheet
    
    For Each ws In ThisWorkbook.Worksheets
        ws.Protect Password:="wmd", Userinterfaceonly:=True
    Next ws
    
    Dim MyRange As Range, c As Range
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set MyRange = Range("A2:A50000")
    MyRange.EntireRow.Hidden = False
    
    For Each c In MyRange
        If IsDate(c.Value) And c.Value < Date Then
            c.EntireRow.Hidden = True
        End If
        
    Next
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
End Sub

What I changed is I used to have 2 separate columns, one for the date which was formatted MM/DD/YYYY (column A) and one for the time (column B). I've now consolidated the two columns into one and changed the format to MM/DD/YYYY HH:SS (column A). I think the problem is with the Next statement, which is why the code is working for one worksheet but not the others, but I'm not sure. Thank you in advance.

-Nick

 

[JLGWhiz]

Put this snippet into your standard code module.

Sub f()
MsgBox TypeName(Selection.Value)
End Sub

Then select a single cell in column A of one of the sheets that does not hide the row. Run the snippet and see if the message box returns "Date" or "String".
If it does not return 'Date' then that is your problem and we can then work to fix it.

 

[nryan]

I do indeed get a return of 'Date'.

 

[JLGWhiz]

I do indeed get a return of 'Date'.

Then the problem is not what I thought it might be. Taking a closer look at the code, maybe this will fix it.

Sub Workbook_Open()
    Dim ws As Worksheet
    Dim MyRange As Range, c As Range
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    For Each ws In ThisWorkbook.Worksheets
        ws.Protect Password:="wmd", Userinterfaceonly:=True
        Set MyRange = Range("A2:A50000")
        MyRange.EntireRow.Hidden = False
        For Each c In MyRange
            If IsDate(c.Value) And c.Value < Date Then
                c.EntireRow.Hidden = True
            End If
        Next
    Next ws
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

 

[nryan]

Late reply due to being busy and Memorial day weekend.

I tried your code and it throws an error if there are no rows to hide on the first sheet. For some reason mine doesn't do this. When there are rows to hide your code works, but only for the first sheet (same issue my code has). You probably don't need to see this but here's the line that throws the error:

MyRange.EntireRow.Hidden = False

Here's all of your code for your reference:

Sub Workbook_Open()    Dim ws As Worksheet
    Dim MyRange As Range, c As Range
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    For Each ws In ThisWorkbook.Worksheets
        ws.Protect Password:="wmd", Userinterfaceonly:=True
        Set MyRange = Range("A2:A50000")
        MyRange.EntireRow.Hidden = False    ''This is where the code breaks.
        For Each c In MyRange
            If IsDate(c.Value) And c.Value < Date Then
                c.EntireRow.Hidden = True
            End If
        Next
    Next ws
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

I'm thinking of just leaving this out because it's more of a nice to have. I think the problem is a combo of the code and the new formatting I applied to the sheets, or maybe the new VBA code I added to each individual worksheet, shown below:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'This code forces the cursor back to the first non-blank cell in the specified range(s) until the user fills
'that cell with something. After filling the cell with data it allows the user to move on.


Dim cel, ProbeInfo, XYData As Range
Set ProbeInfo = Range("B2:H50000")


  For Each cel In ProbeInfo
    If IsEmpty(cel) Then
      cel.Select
      Exit Sub
    End If
  Next cel


End Sub

The prior rev didn't have this and didn't have any problems with hiding rows on all the sheets. I'm thinking that with the above code the cursor will always go to the cell the user should be viewing or entering data in, so hiding the previous rows seems redundant when I think about it. If you or anyone has anymore ideas on how to fix the issue I want to hear them.

Thanks.