Time Tracker Code Clean-Up

SubversiveInterloper

SubversiveInterloper

New Member
Joined
Aug 15, 2019
Messages
12
Workbook: Time Tracker Workbook

The workbook has 45 different modules: 15 modules for Start/Resume, 15 modules for Stop & 15 modules for Reset. The only difference in the 'families' is the Row/Line they refer to (2 thru 16). Each module has been assigned to a 'button' on the corresponding Row/Line.

Start/Resume Module:
Sub Time_Sheet01_Start_Timer()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Time Sheet")
sh.Range("K2").Value = "Start"
If sh.Range("L2").Value = "" Then
sh.Range("L2").Value = Now
End If
x:
VBA.DoEvents
If sh.Range("K2").Value = "Stop" Then Exit Sub
sh.Range("M2").Value = Now
GoTo x
End Sub
Click to expand...

Stop Module:
Sub Time_Sheet01_Stop_Timer()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Time Sheet")
sh.Range("K2").Value = "Stop"
Range("D2").Select
Selection.Copy
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("L2:M2").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A1").Select
End Sub
Click to expand...

Reset Module:
Sub Time_Sheet01_Reset_Timer()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Time Sheet")
Range("E2").Select
ActiveCell.FormulaR1C1 = "0"
Range("A1").Select
End Sub
Click to expand...

Just looking to see if there is a cleaner code.
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Sort by date Sort by votes
Hi.

so when you say 45 modules. Do you actually mean 45 macros. Probably irrelevant anyway.

it looks like you need to simply detect if button 2 was pressed, then your code operates on line 2. Or 3,4-16 etc.
Is that correct.

also your code can be written shorter.

your buttons you speak of, are the form control buttons ?
 
Upvote 0
Hi

Not exactly sure how your workbook is set up, but look at the below as a little example.


This is assuming that your buttons are within a cell as a form button. It looks to the tope left of the cell the button is in to determin the row number.

so now that outputs the rownumber to use in your codes.

Then each button simply calls the 1st macro "get_row" so you can literally copy and paste the buttons without refering to several macros.

hope it makes sense, i modified your code a bit, so untested, but the principal of what is done here should work with your code.

Dave

VBA Code: 
Public rownumber As Integer
Sub get_row()
    Dim b As Object, rownumber As Integer
    Set b = ActiveSheet.Buttons(Application.Caller)
    With b.TopLeftCell
        rownumber = .Row
    End With
    Time_Sheet01_Start_Timer
End Sub
Sub Time_Sheet01_Start_Timer()
Range("'Time Sheet'!K" & rownumber) = "Start"
If Range("'Time Sheet'!L" & rownumber) = "" Then Range("'Time Sheet'!L" & rownumber) = Now
Do Until Range("'Time Sheet'!K" & rownumber) = "Stop"
    DoEvents
    Range("'Time Sheet'!M" & rownumber) = Now
Loop
End Sub
Sub Time_Sheet01_Stop_Timer()
sRange("'Time Sheet'!K" & rownumber) = "Stop"
Range("D" & rownumber).Copy
Range("E" & rownumber).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("L2:M2").ClearContents
Range("L" & rownumber & ":M" & rownumber).ClearContents
End Sub
Sub Time_Sheet01_Reset_Timer()
Range("E" & rownumber) = "0"
End Sub
 
Upvote 0
Hi

So scrap the one above, hopefully i have understood what you require fully now.

With the below code in 1 module.
Create 3 form buttons and edit the text(caption) within them to be as follows. START,STOP AND RESET. Or modify the code to suit your preferred names.
Assign all 3 buttons to the macro "get_row"
Again, the buttons must be within the row number you are wishing to manipulate.
If it works simply copy and paste the buttons to all the rows you wish to manipulate.

When you press any of the buttons, the macro"get_row" will recongise what row the button is in, and if the button is called START,STOP OR RESET. it can then execute the relevant code.

Where i have changed or simplified your code, if you was refering to sheet time sheet, i have done the same, but at some positions you was not refering to sheets time sheet, so i have therefor left them without a sheet reference, but i would imaging all of this is happening in 1 sheet? and therefor should be changed to suit.


VBA Code: 
Public RN As Integer
Sub get_row()
Dim b As Object
Set b = ActiveSheet.Buttons(Application.Caller)
With b.TopLeftCell
    RN = .Row
End With
If ActiveSheet.Buttons(Application.Caller).Caption = "START" Then Time_Sheet01_Start_Timer
If ActiveSheet.Buttons(Application.Caller).Caption = "STOP" Then Time_Sheet01_Stop_Timer
If ActiveSheet.Buttons(Application.Caller).Caption = "RESET" Then Time_Sheet01_Reset_Timer
End Sub
Sub Time_Sheet01_Start_Timer()
Range("'Time Sheet'!K" & RN) = "Start"
If Range("'Time Sheet'!L" & RN) = "" Then Range("'Time Sheet'!L" & RN) = Now
Do Until Range("'Time Sheet'!K" & RN) = "Stop"
    DoEvents
    Range("'Time Sheet'!M" & RN) = Now
Loop
End Sub
Sub Time_Sheet01_Stop_Timer()
Range("'Time Sheet'!K" & RN) = "Stop"
Range("D" & RN).Copy
Range("E" & RN).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("L" & RN & ":M" & RN).ClearContents
End Sub
Sub Time_Sheet01_Reset_Timer()
Range("E" & RN) = "0"
End Sub

Good Luck

dave
 
Upvote 0
Hello Squidd,
Thank you for your efforts while I was away.

In response to some of your earlier questions; yes, modules = macros. Also, the buttons aren't actually command buttons, but inserted shapes. I provided a link to the workbook in my original post, but appears I screwed that up, apologies. Here it is again: Harvest Daily Time Tracker (Final).xlsm

I figured with the buttons not being command buttons the above code wouldn't work, but I gave it a try regardless. Hopefully, actually having the workbook can help.

1633354617451.png
 
Upvote 0
Hi

so i tweaked it about a bit.

make sure all you buttons call macro "get_row"
And your sheet is still called "Time Sheet"
I have coded in the resume, however, your original post dis not have the resume macro, so you need to add the name where i have commented green.

VBA Code: 
Public RN As Integer
Sub get_row()
C = ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text
Set b = ActiveSheet.Shapes(Application.Caller)
RN = b.TopLeftCell.Row
If C = "START" Then Time_Sheet01_Start_Timer
If C = "STOP" Then Time_Sheet01_Stop_Timer
If C = "RESET" Then Time_Sheet01_Reset_Timer
'If C = "RESUME" Then 'CALL YOUR RESUME MACRO
End Sub
Sub Time_Sheet01_Start_Timer()
Range("'Time Sheet'!K" & RN) = "Start"
If Range("'Time Sheet'!L" & RN) = "" Then Range("'Time Sheet'!L" & RN) = Now
Do Until Range("'Time Sheet'!K" & RN) = "Stop"
    DoEvents
    Range("'Time Sheet'!M" & RN) = Now
Loop
End Sub
Sub Time_Sheet01_Stop_Timer()
Range("'Time Sheet'!K" & RN) = "Stop"
Range("D" & RN).Copy
Range("E" & RN).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("L" & RN & ":M" & RN).ClearContents
End Sub
Sub Time_Sheet01_Reset_Timer()
Range("E" & RN) = "0"
End Sub
 
Last edited:
Upvote 0
The 'RESUME' macro is the same as the 'START' macro, so I just copied and pasted the 'Start' and labeled it 'Resume'.

The Sub Time_Sheet01_Stop_Timer() has a couple of issues though.
1.) It is only clears the contents of "L" on the intial click, but clicking 'Stop' a second time will clear the contents of "M".
2.) When it is copying & pasting the values of "E" into "D", the formatting changes to include the date and shows the difference between the current time & midnight of January 01, 1900 (as seen in the top row).

1633369703938.png
 
Upvote 0
Hi

ok, i am not sure exactly waht you require on the copy and paste, is it just the difference between the start and the stop time in time format?

The below should now at least clear properly when you hit stop.

i have changed the code from copy and paste, but still think this part is not correct.

make sure to copy and paste it all, as not just the stop code have been changed.

Dave

VBA Code: 
Public RN As Integer
Sub get_row()
C = ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text
Set b = ActiveSheet.Shapes(Application.Caller)
RN = b.TopLeftCell.Row
If C = "START" Then Time_Sheet01_Start_Timer
If C = "STOP" Then Time_Sheet01_Stop_Timer
If C = "RESET" Then Time_Sheet01_Reset_Timer
If C = "RESUME" Then Time_Sheet01_Resume_Timer
End Sub
Sub Time_Sheet01_Start_Timer()
Range("'Time Sheet'!K" & RN) = "Start"
If Range("'Time Sheet'!L" & RN) = "" Then Range("'Time Sheet'!L" & RN) = Now
Do Until Range("'Time Sheet'!K" & RN) = "Stop"
    DoEvents
    Range("'Time Sheet'!M" & RN) = Now
    If Range("'Time Sheet'!K" & RN) = "Stop" Then Range("'Time Sheet'!L" & RN & ":M" & RN).ClearContents
Loop
End Sub
Sub Time_Sheet01_Reset_Timer()
Range("'Time Sheet'!E" & RN) = "0"
End Sub
Sub Time_Sheet01_Resume_Timer()
Range("'Time Sheet'!K" & RN) = "Start"
If Range("'Time Sheet'!L" & RN) = "" Then Range("'Time Sheet'!L" & RN) = Now
Do Until Range("'Time Sheet'!K" & RN) = "Stop"
    DoEvents
    Range("'Time Sheet'!M" & RN) = Now
Loop
End Sub
Sub Time_Sheet01_Stop_Timer()
Range("'Time Sheet'!K" & RN) = "Stop"
Range("'Time Sheet'!E" & RN) = Format(Range("'Time Sheet'!M" & RN) - Range("'Time Sheet'!L" & RN), "HH:MM:SS")
End Sub
 
Upvote 0
Thanks for the great feedback.

Your welcome.
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
Worksheet from a template using a master list but protecting existing worksheets
Replies
0
Views
226
Alfalfa166
A
K
  • Solved
fix error 1004 when the sheet is protected
Replies
1
Views
320
dave3009
dave3009
Agnarr
  • Question
VBA problem with creating new sheets
Replies
0
Views
341
Agnarr
Agnarr
F
  • Solved
Date and Time not showing
2
Replies
12
Views
514
Skyybot
Skyybot
Agnarr
  • Question
VBA code mix
Replies
1
Views
352
Joe4
Joe4

Forum statistics

Threads
1,214,833
Messages
6,121,857
Members
449,051
Latest member
excelquestion515

Share this page

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