Hide/Unhide Rows Based on date on another sheet

[james7705]

Hello
I'm looking to hide rows based on a date value on another sheet. I have a date on "Index!C1" formatted to dd/mm/yyyy.
On "Sheet2" through to "Sheet26" I have column B9 to B39 populated with numbers from 1 to 31.
Column A9 to A39 is formatted to show the day as "dddd" referencing column B and the month and year from "Index!C1" with this formula (=DATE(B7;A7;B9) A7 being equal to "Index!C1"
I would like to hide the last row (39) on all the sheets if the month only has 30 days or the last 3 rows if it is February.
This is the code I'm using, but it is not working and I'm not sure what I am doing as I am very new to vba.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim x As Long

If Not Intersect(Target, Range("Index!C1")) Is Nothing Then
    x = Day(WorksheetFunction.EoMonth(Range("Index!C1").Value, 0))
    Range("B:B").Resize(rowsize:=x).EntireRow.Hidden = False
    If x < 31 Then
        Range("B9:B39").Offset(0, x - 28).Resize(rowsize:=31 - x).EntireRow.Hidden = True
    End If
End If

Any help would be greatly appreciated. Thank you.

 

[eirikdaude]

The codename is different from the sheetname, and will most likely not be changed by your users. It can be edited in the VBA editor as the topmost line of the properties when you highlight a sheet. But yeah, you could loop over all the sheets and check if their names are unlike Index or Exception Report too.

 

[james7705]

I'd recommend working with the codenames of the sheets in that case. Can you ensure that each sheet containing employee data e.g. has a codename like "employee1"? In that case you can just make the loop

For Each ws in Thisworkbook.Worksheets
    If InStr(1, StrConv(ws.CodeName, vbLowerCase), "employee", vbTextCompare) > 0 Then
        ' The code to hide the rows
    End If
Next ws

You could possibly do something like

if strconv(ws.codename, vblowercase) = "sheet" & cstr(i) then
' code to hide rows
end if

In the code I already gave you, without changing the codenames, but this will be much more prone to failure

Ok...so with the 1st one...I have changed the codenames on my employee data sheets to be employee1, 2, 3...etc. What would I need to substitute? I assume these lines

For i = 2 To 26
            With ThisWorkbook.Worksheets("Sheet" & CStr(i))
                .Rows("37:39").Hidden = False

will no longer be needed?

Would this be correct?

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  
    Dim date_cell As Range
    Dim days_in_month As Long
    Dim i As Long
    Dim ws As Worksheet
   
    Set date_cell = Me.Range("C1")

    If Not Intersect(Target, date_cell) Is Nothing Then
        days_in_month = Day(WorksheetFunction.EoMonth(date_cell, 0))
       
For Each ws In ThisWorkbook.Worksheets
    If InStr(1, StrConv(ws.CodeName, vbLowerCase), "employee", vbTextCompare) > 0 Then
                .Rows("37:39").Hidden = False
                Select Case days_in_month
                    Case 28:
                        .Rows("37:39").Hidden = True
                    Case 29:
                        .Rows("38:39").Hidden = True
                    Case 30:
                        .Rows(39).Hidden = True
                    Case Else:
                End Select
            End With
        Next i
    End If
    End If
Next ws
End Sub

 

[eirikdaude]

Add

With ws

after

If InStr(1, StrConv(ws.CodeName, vbLowerCase), "employee", vbTextCompare) > 0 Then

and before

.Rows("37:39").Hidden = False

in your last code block

 

[james7705]

Fantastic...it works...thank you so much.
Just one last question...(I know I'm being a pain) I need to put code in now to unprotect the sheet, hide the rows and then protect the sheet again as the code does not run on a protected sheet.
Where would that go? and what would the syntax be?

 

[eirikdaude]

I use these two helper functions to lock and unlock my worksheets

Sub unlock_sheet(ByVal ws As Worksheet, Optional pw As String)
    If ws.ProtectContents = True Then
        ws.Unprotect Password:=PASSORD
    End If
End Sub

Sub lock_sheet(ByVal ws As Worksheet, Optional pw As String)
    If Len(pw) = 0 Then
        ws.Protect DrawingObjects:=False, contents:=True, Scenarios:=True, AllowSorting:=True, AllowFiltering:=True
    Else
        ws.Protect Password:=pw, DrawingObjects:=False, contents:=True, Scenarios:=True, AllowSorting:=True, AllowFiltering:=True
    End If
    ws.EnableSelection = xlUnlockedCells
End Sub

You'll have to edit what should be protected in the second of these functions, as well as deciding on what can be selected in your sheet. For getting an overview on what options you have, I'd have a look at Microsoft's documentation on Worksheet.Protect and Worksheet.EnableSelection.

As for where you'd put it, it'd be after you decide to edit the sheet and after you're done editing it - i.e. after the if-statement deciding this and before the end if at the end of the editing:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  
    Dim date_cell As Range
    Dim days_in_month As Long
    Dim i As Long
    Dim ws As Worksheet
   
    Set date_cell = Me.Range("C1")

    If Not Intersect(Target, date_cell) Is Nothing Then
        days_in_month = Day(WorksheetFunction.EoMonth(date_cell, 0))
       
    For Each ws In ThisWorkbook.Worksheets
        If InStr(1, StrConv(ws.CodeName, vbLowerCase), "employee", vbTextCompare) > 0 Then
            call unlock_sheet(ws) ' if you want to password protect the worksheet this would be unlock_sheet(ws, "password")
            With ws
                .Rows("37:39").Hidden = False
                Select Case days_in_month
                    Case 28:
                        .Rows("37:39").Hidden = True
                    Case 29:
                        .Rows("38:39").Hidden = True
                    Case 30:
                        .Rows(39).Hidden = True
                    Case Else:
                End Select
            End With
            call lock_sheet(ws)
        Next i
    End If
    End If
Next ws
End Sub