Apr 02 2021 06:29 PM - edited Apr 03 2021 05:33 PM
Hi all. I'm new here.
I would like to create a button macro that when I click it, it will go to a cell according to the time (each cell represents a 15 min time) and increase the number in that cell by one.
Apr 03 2021 12:35 AM
Please attach a sample workbook without sensitive data.
Apr 03 2021 10:20 PM
Please find the attached with the code on Module1. I replaced the ActiveX Commandbuttons you inserted on Input Sheet with the Rectangular Shapes and renamed them properly to make it work correctly. Please don't mess with the names and captions of these buttons. The code on Module1 is assigned to all of these buttons.
Code on Module1:
Sub FillData()
Dim wsInput As Worksheet
Dim wsData As Worksheet
Dim shp As Shape
Dim TimeCol As Variant
Dim x As Long
Dim r As Variant
Dim EType As String
Dim Region As String
If Time > TimeSerial(18, 30, 0) And Time < TimeSerial(5, 30, 0) Then
MsgBox "Out of scheduled time!", vbExclamation
Exit Sub
End If
Set wsInput = ThisWorkbook.Worksheets("Input Sheet")
Set wsData = ThisWorkbook.Worksheets("Data Sheet")
Set shp = wsInput.Shapes(Application.Caller)
EType = shp.OLEFormat.Object.Caption
Region = Split(shp.Name, "_")(1)
If EType = "Emp" Then
x = 0
ElseIf EType = "Vet" Then
x = 1
End If
On Error Resume Next
TimeCol = Application.Match(CDbl(Time), wsData.Rows(3))
r = Application.Match(Region, wsData.Columns(1), 0)
On Error GoTo 0
If IsError(TimeCol) Then
MsgBox "No time slot was found on Data Sheet!", vbExclamation
Exit Sub
End If
If IsError(r) Then
MsgBox "No header for """ & Region & """ was found in column A of " & wsData.Name & "!", vbExclamation
Exit Sub
End If
With wsData.Cells(r, TimeCol + x)
.Value = 1
.Interior.Color = vbYellow
End With
Application.Goto wsData.Cells(r, TimeCol + x)
End Sub
Apr 04 2021 07:44 AM
Apr 04 2021 08:43 AM
One more thing. The count on the data sheet only goes to one. I would like to increase what ever number is there by 1 each time I click the bottom. So if I click it four times in one 15 min period it will show 4.
What I am trying to achieve is to track how many employees and veterans I pick up in my shuttle bus at each of my shuttle stops.
Thanks for your help.
Phil
Apr 04 2021 08:58 AM
SolutionNear the end of the macro, change the part
With wsData.Cells(r, TimeCol + x)
.Value = 1
.Interior.Color = vbYellow
End With
to
With wsData.Cells(r, TimeCol + x)
.Value = .Value + 1
.Interior.Color = vbYellow
End With
And near the beginning, the line
If Time > TimeSerial(18, 30, 0) And Time < TimeSerial(5, 30, 0) Then
should be
If Time > TimeSerial(18, 30, 0) Or Time < TimeSerial(5, 30, 0) Then
See the attached version with the modified version of Subodh_Tiwari_sktneer's code.
Apr 04 2021 10:22 AM
Thanks for pointing out the error in logical condition and thanks for tweaking the code. That was a silly mistake, my bad.
Apr 04 2021 10:25 AM
Apr 04 2021 08:58 AM
SolutionNear the end of the macro, change the part
With wsData.Cells(r, TimeCol + x)
.Value = 1
.Interior.Color = vbYellow
End With
to
With wsData.Cells(r, TimeCol + x)
.Value = .Value + 1
.Interior.Color = vbYellow
End With
And near the beginning, the line
If Time > TimeSerial(18, 30, 0) And Time < TimeSerial(5, 30, 0) Then
should be
If Time > TimeSerial(18, 30, 0) Or Time < TimeSerial(5, 30, 0) Then
See the attached version with the modified version of Subodh_Tiwari_sktneer's code.