Enable commandbutton based on time

macea1987

New Member
Joined
Mar 6, 2015
Messages
12
Hi Guys,

I have a cell on sheet 1 which updates every second with the current time. the format of this cell is hh:mm:ss. I then have a sheet with cells for different premises again with the format hh:mm:ss. I have a command button for each premises on a page. However, i dont want anyone to be able to click on the commandbutton for each premises unless the time now is + 20 min either side of the times on the sheet with times listed.

So if the time on the "Schedule" sheet is 09:00, i only want the button the be active if the time is within 08:40 or 09:20. The Schedule page has the different premises listed in Column A and then the scheduled times in columns B to M. Each site having 12 times against it.

Really hoping someone can help.

Thanks,

Alan
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
7,158
Office Version
2019
Platform
Windows
Easier to let them click but don't let the button do anything.

Code:
Sub your_button_click()
Dim yourtime As Double
yourtime = TimeValue("09:00:00")
If Time >= (yourtime - TimeValue("00:20:00")) And Time <= (yourtime + TimeValue("00:20:00")) Then
    ' do stuff here
End If
End Sub
I've used a variable to define the schedule time, but you could pull this from the schedule sheet based on the button clicked just as easily.
 

macea1987

New Member
Joined
Mar 6, 2015
Messages
12
Thanks for replying Jason. It looks like it should work. How would i reference the cell where the time is located rather than specifying the time in vba? also if i have an entire sheet with times listed in the cells is there anyway of not allowing any of the buttons to do anything if the time is over the specified times in the code you provided?
 

macea1987

New Member
Joined
Mar 6, 2015
Messages
12
Basically this is how im referencing cells except its messy and im not sure how to tidy it up. But if
Code:
wslog.range("Y42").Value
which is the current time, updated every second, matches the value in one of the following
Code:
If CommandButton21.BackColor = 15592941 And wslog.Range("Y42").Value = ws.Range("B2") Or wslog.Range("Y42").Value = ws.Range("C2") Or wslog.Range("Y42").Value = ws.Range("D2") Or wslog.Range("Y42").Value = ws.Range("E2") Or wslog.Range("Y42").Value = ws.Range("F2") Or wslog.Range("Y42").Value = ws.Range("G2") Or wslog.Range("Y42").Value = ws.Range("H2") Then
CommandButton21.BackColor = vbBlue
areyouready = MsgBox("Site Tour Due", vbOKOnly + vbQuestion, "Site Detail (Ref Number)")
End If
I need it that when the time exceeds 20 min either side of the value in one of the referenced cells above, it flags a message to the user if its 20 min before. If its 20 min late, populate a cell on sheet 2 with "Late"
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
7,158
Office Version
2019
Platform
Windows
What code do you currently have for the buttons?

Do they all run the same piece of code, or does each one have its own code?

My first thought is to use application caller to get the name of the button then use that to look up the time in the schedule sheet and pull that back to the variable. Although, for that to work easily the button names would need to be the same as the same as the names listed in column A of the schedule, would that work?
 

macea1987

New Member
Joined
Mar 6, 2015
Messages
12
The code for the buttons is below. But in all honesty im open to any idea that would simplify things.
Code:
Private Sub CommandButton211_Click()
Dim wslog As Worksheet 'Abbreviation of Worksheet is wslog
Dim ws As Worksheet 'Abbreviation of worksheet is ws
Dim lrow As Long 'Abbreviation of Long is lrow
Dim connect As Integer
Set ws = ThisWorkbook.Sheets("Main") ' Definition of ws
Set wslog = ThisWorkbook.Sheets("Log") ' Definition of wslog
Set wslogr = ThisWorkbook.Sheets("Results") ' Definition of wslogr
lrow = wslogr.Cells(Rows.count, "A").End(xlUp).Row + 1 ' Moves the Row Down on New Addition
wslogr.Range("B" & lrow) = Now  'Date and Time Now
wslogr.Range("A" & lrow) = CommandButton211.Caption  'Site Name
wslogr.Range("D" & lrow) = ws.Range("E1")  'Agent ID
wslogr.Range("E" & lrow) = Environ("Username") 'Stamps Windows Login
connect = MsgBox("Are you able to Connect to the Site?", vbYesNo + vbQuestion, "Site Status")
If connect = vbNo Then
wslogr.Range("C" & lrow) = "Cannot Connect"
CommandButton211.BackColor = vbRed
ThisWorkbook.Save
Else
CommandButton211.BackColor = vbGreen
StartGT
CommandButton211.BackColor = vbYellow
ThisWorkbook.Save
End If
End Sub
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
7,158
Office Version
2019
Platform
Windows
Looking at that, I'm assuming that you have a similar piece of code for each button, with the name of the command button changed each time, would that be correct?

Are there any other differences to the code?

I've attempted a generic version, see if this gets you in the right direction.

Code:
Private Sub CommandButton_Click()
Dim wslog As Worksheet 'Abbreviation of Worksheet is wslog
Dim ws As Worksheet 'Abbreviation of worksheet is ws
Dim lrow As Long 'Abbreviation of Long is lrow
Dim connect As Integer
Set ws = ThisWorkbook.Sheets("Main") ' Definition of ws
Set wslog = ThisWorkbook.Sheets("Log") ' Definition of wslog
Set wslogr = ThisWorkbook.Sheets("Results") ' Definition of wslogr
lrow = wslogr.Cells(Rows.Count, "A").End(xlUp).Row + 1 ' Moves the Row Down on New Addition
If wslogr.Buttons(Application.Caller).BackColor = 15592941 Then
    With Application.WorksheetFunction
        If .Lookup(wslog.Range("Y42").Value + TimeValue("00:20:00"), .Index(ws.Range("B2:H200"), .Match(wslogr.Buttons(Application.Caller).Caption, ws.Range("A2:A200"), False), 0)) <= wslog.Range("Y42").Value + TimeValue("00:20:00") Then
            MsgBox "error, not in permitted time frame"
            Exit Sub
        End If
    End With
End If
wslogr.Range("B" & lrow) = Now  'Date and Time Now
wslogr.Range("A" & lrow) = wslogr.Buttons(Application.Caller).Caption  'Site Name
wslogr.Range("D" & lrow) = ws.Range("E1")  'Agent ID
wslogr.Range("E" & lrow) = Environ("Username") 'Stamps Windows Login
connect = MsgBox("Are you able to Connect to the Site?", vbYesNo + vbQuestion, "Site Status")
If connect = vbNo Then
wslogr.Range("C" & lrow) = "Cannot Connect"
wslogr.Buttons(Application.Caller).BackColor = vbRed
ThisWorkbook.Save
Else
wslogr.Buttons(Application.Caller).BackColor = vbGreen
StartGT
wslogr.Buttons(Application.Caller).BackColor = vbYellow
ThisWorkbook.Save
End If
End Sub
I'm not too keen on the idea of message if early or defaulting to late, given that there are multiple time windows through the day, it would be too easy to apply the wrong flag.

You would need to cross check against the last record entered to see if the current entry attempt is early for the next time frame, or late for the previous one.

Best to think over problems like that in a room with soft walls and no sharp objects! :banghead:
 

macea1987

New Member
Joined
Mar 6, 2015
Messages
12
The name of the command button stays the same and the caption in the button remains the same. Each caption been a site name. That caption is grabbed and then stamped on a "Log" Sheet.
 

macea1987

New Member
Joined
Mar 6, 2015
Messages
12
So im not sure as to whether the above code will work? will it? im getting loads of error messages when it reaches the
Code:
If wslogr.Buttons(Application.Caller).BackColor = 15592941 Then
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
7,158
Office Version
2019
Platform
Windows
What I meant was that

Button_1 has caption abc and runs Sub Command_Button_1_Click()
Button_2 has caption def and runs Sub Command_Button_2_Click()
etc.

But beyond that there are no differences to the code, each performs the same task based on which button is clicked.

If that is the case then you don't need Sub Command_Button_1_Click(), Sub Command_Button_2_Click() etc. just Sub Command_Button_Click() with Application.Caller to identify the button clicked.

wslogr.Buttons(Application.Caller).Caption gets the caption from the button that was clicked so you don't need to specify each button in the code.

Where are the buttons located? I've assumed the sheet that you set to wslogr in your code, if that is not correct then you would need to change that to the correct sheet.

Depending on the type of object used as a button, you might need to change .Buttons( to .Shapes(
 
Last edited:

Forum statistics

Threads
1,082,585
Messages
5,366,466
Members
400,892
Latest member
lamarh755

Some videos you may like

This Week's Hot Topics

Top