Change Button colour, when VBA lock sheets

[KlausW]

Hello
Some who can help.
I have a challenge, I use this VBA code to lock sheets with by date/time in cell A1. The code is in this workbook. It works really well.
I use it to record who eats on the different days, which are from sheets 1 to 30 or 1 to 31 depending on which month you are in.
There is a CommandButton1 in each sheet so that you can manually lock and open the individual sheets.
When the VBA code locks the sheet, CommandButton1 in the applicable sheet must change from green to red and the text must change from "Open" to "Locked".
Example.
On 1 January 2024 at 12:30, sheets 2 will lock and CommandButton1 in sheets 2 must change from green to red and the text must change from "Open" to "Locked".
On January 2, 2024 at 12:30, sheets 3 will lock and CommandButton1 in sheets 3 must change from green to red and the text must change from "Open" to "Locked".
On January 3, 2024 at 12:30, sheets 4 will lock and CommandButton1 in sheets 4 must change from green to red and the text must change from "Open" to "Locked". ETC.
Any help will be appreciated
Best regards
Klaus W

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

Dim Dato As Date

Dato = ActiveSheet.Range("A1").Value

If Not Intersect(ActiveCell, Range("C6:E6")) Is Nothing Then

If Now > Dato Then GoTo 10

Else:

End If

GoTo 20
10:

'MsgBox "Tiden er udløbet, der kan ikke indtastes i cellerne"
MsgBox "The time has expired, cannot be entered in the cells"
Range("A1").Select
Application.EnableEvents = True
'Call Laas my macro name
Exit Sub

20:
Application.EnableEvents = True
cancel = True

End Sub

 

[Micron]

Just change the backcolor and caption properties in either the sheet locking or button click code? Perhaps

With Sheets("Sheet 2").CommandButton1
   If .Caption = "Open" Then
      .Backcolor = vbRed
      .Caption = "Closed"
   End If
End With

 

[KlausW]

Just change the backcolor and caption properties in either the sheet locking or button click code? Perhaps

With Sheets("Sheet 2").CommandButton1
   If .Caption = "Open" Then
      .Backcolor = vbRed
      .Caption = "Closed"
   End If
End With

Yes just change the background color and caption every time a sheet is locked. I can't figure out where to put the code. KW

 

[Micron]

Let's see one of your button click event codes?

When the VBA code locks the sheet

The code you posted does not do that, so I can't tell where it needs to go. If it's not the button click event that locks the sheet then post that code also.

 

[KlausW]

This is the code to lock and unlock.

It is a combination the sheet must lock automatically when there is a deadline. The day before at 1 PM. But as an administrator, you must be able to unlock the sheet. Does that make sense.KW

Private Sub CommandButton1_Click()

With CommandButton1
        If .BackColor = vbGreen Then
            .BackColor = vbRed
            .Caption = "Close"
            
            ProtectSheetWithPasswordFromUser
                       
        Else
            .BackColor = vbGreen
            .Caption = "Open"
            
            UnProtectSheetWithPasswordFromUser
       
                        
            End If
    End With

End Sub
Sub ProtectSheetWithPasswordFromUser()

'Protect worksheet with a password
Sheets("31").Protect Password:=InputBox("Enter a protection password:")

End Sub

Sub UnProtectSheetWithPasswordFromUser()

pass = InputBox("Password?")
On Error GoTo Popup:
ActiveSheet.Unprotect pass


Exit Sub
Popup:
If Err.Number = 1004 Then
MsgBox "Incorrect Password", vbCritical, "Admin"
End If

End Sub

 

[Micron]

As I mentioned in post 4 the code you first posted does not lock the sheets. Now I can see that the button click code doesn't do that either, but it appears it calls a sub that locks the sheets. I also now see that you have a button click event with code that looks like what I posted. So what is wrong with that? Are you wanting this to happen when a certain range is selected and today's date is after the date in A1? Then I think put what I posted in ProtectSheetWithPasswordFromUser sub. If you want admins to be able to call it with the button, put a call to ProtectSheetWithPasswordFromUser there also. However I think I'd do more like

By passing parameters to a procedure you can use it for different situations. Rather than have one to lock and another to unlock, have one to which you pass the values you need. In this case I'm using True or False to protect or not (thus unprotect). You could also use a string instead of a boolean ("Protect" or "Unprotect").

Sub PswrdProtectSheet(shtName As String, bolTF As Boolean)
'your password setting code here
End Sub

If you want to lock the sheet from the selection change event:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

If Not Intersect(ActiveCell, Range("C6:E6")) Is Nothing Then
    If Now > ActiveSheet.Range("A1") Then
        'MsgBox "Tiden er udløbet, der kan ikke indtastes i cellerne"
        MsgBox "The time has expired, cannot be entered in the cells"
        Range("A1").Select
        'Call Laas my macro name
        PswrdProtectSheet(sht.Name,True)
        Exit Sub
    End If
End If

'if not turned off elsewhere this line is not needed?
Application.EnableEvents = True

'this event has no Cancel parameter. Likely you are not using Option Explicit, otherwise, should raise an error.
'cancel = True

End Sub

You could also avoid the nested If's like this:
If Not Intersect(ActiveCell, Range("C6:E6")) Is Nothing And Now > ActiveSheet.Range("A1") Then

Using GoTo to control code flow is generally considered to be poor practice. Should be more like above code, with proper indentation. Your use of code tags in your posts is good and appreciated but the lack of indentation can make code harder to troubleshoot.
HTH

 

[KlausW]

As I mentioned in post 4 the code you first posted does not lock the sheets. Now I can see that the button click code doesn't do that either, but it appears it calls a sub that locks the sheets. I also now see that you have a button click event with code that looks like what I posted. So what is wrong with that? Are you wanting this to happen when a certain range is selected and today's date is after the date in A1? Then I think put what I posted in ProtectSheetWithPasswordFromUser sub. If you want admins to be able to call it with the button, put a call to ProtectSheetWithPasswordFromUser there also. However I think I'd do more like

By passing parameters to a procedure you can use it for different situations. Rather than have one to lock and another to unlock, have one to which you pass the values you need. In this case I'm using True or False to protect or not (thus unprotect). You could also use a string instead of a boolean ("Protect" or "Unprotect").

Sub PswrdProtectSheet(shtName As String, bolTF As Boolean)
'your password setting code here
End Sub

If you want to lock the sheet from the selection change event:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

If Not Intersect(ActiveCell, Range("C6:E6")) Is Nothing Then
    If Now > ActiveSheet.Range("A1") Then
        'MsgBox "Tiden er udløbet, der kan ikke indtastes i cellerne"
        MsgBox "The time has expired, cannot be entered in the cells"
        Range("A1").Select
        'Call Laas my macro name
        PswrdProtectSheet(sht.Name,True)
        Exit Sub
    End If
End If

'if not turned off elsewhere this line is not needed?
Application.EnableEvents = True

'this event has no Cancel parameter. Likely you are not using Option Explicit, otherwise, should raise an error.
'cancel = True

End Sub

You could also avoid the nested If's like this:
If Not Intersect(ActiveCell, Range("C6:E6")) Is Nothing And Now > ActiveSheet.Range("A1") Then

Using GoTo to control code flow is generally considered to be poor practice. Should be more like above code, with proper indentation. Your use of code tags in your posts is good and appreciated but the lack of indentation can make code harder to troubleshoot.
HTH

Thank you very much, I'll look into it and return tomorrow, it's getting late in the evening in Denmark. KW

 

[Micron]

FYI, that first little snippet of code should have gone between my two paragraphs. Thought I'd point that out in case you found my post confusing.