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
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
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.
 
Upvote 0
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?
 
Upvote 0
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"
 
Upvote 0
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?
 
Upvote 0
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
 
Upvote 0
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! :oops:
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
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:
Upvote 0

Forum statistics

Threads
1,214,908
Messages
6,122,187
Members
449,071
Latest member
cdnMech

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top