AHT Recorder

[Chefsohail]

Hi Team,

Need your help with developing a macro sheet where we have a button that Records start time and end time.

1. Time format - h:mm:ss AM/PM;@
2. Formulae as per the image.
3. The user hits the record time and it should automatically add '1' in cell C4 and record the time in cell D4. Then the user will press the same button again to end the time and it should enter the end time in cell E4. The AHT should get calculated in Cell F4 with format mm:ss
4. Now the user again presses the button and the system should add '2' in C5, record the start time in D5. Once the work is finished the user will use the same button to end time and it should record the end time in cell E5. AHT calculated.
5. Now again the user presses the same button and cell C6 should have '3', D6 start time and later E6 end time and F6 with AHT.

Please help.

 

[mumps]

Click here for your file. This is the code in Module1:

Sub ToggleMacro()
    Dim lRow As Long
    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim s As Date, e As Date
    With ActiveSheet.Shapes("Button 2").TextFrame.Characters
        If lRow <= 3 Then
            If .Text = "Start Timer" Then
                Range("C4") = 1
                Range("D4") = Format(Time, "h:mm:ss AM/PM;@")
                .Text = "Stop Timer"
            Else
                Range("E4") = Format(Time, "h:mm:ss AM/PM;@")
                s = Range("D" & lRow)
                e = Range("E" & lRow)
                Range("F4") = Format(e - s, "h:mm:ss")
                .Text = "Start Timer"
            End If
        Else
            If .Text = "Start Timer" Then
                Range("C" & lRow + 1) = Range("C" & lRow) + 1
                Range("D" & lRow + 1) = Format(Time, "h:mm:ss AM/PM;@")
                .Text = "Stop Timer"
            Else
                Range("E" & lRow) = Format(Time, "h:mm:ss AM/PM;@")
                s = Range("D" & lRow)
                e = Range("E" & lRow)
                Range("F" & lRow) = Format(e - s, "h:mm:ss")
                .Text = "Start Timer"
            End If
        End If
    End With
End Sub

 

[Chefsohail]

Click here for your file. This is the code in Module1:

Sub ToggleMacro()
    Dim lRow As Long
    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim s As Date, e As Date
    With ActiveSheet.Shapes("Button 2").TextFrame.Characters
        If lRow <= 3 Then
            If .Text = "Start Timer" Then
                Range("C4") = 1
                Range("D4") = Format(Time, "h:mm:ss AM/PM;@")
                .Text = "Stop Timer"
            Else
                Range("E4") = Format(Time, "h:mm:ss AM/PM;@")
                s = Range("D" & lRow)
                e = Range("E" & lRow)
                Range("F4") = Format(e - s, "h:mm:ss")
                .Text = "Start Timer"
            End If
        Else
            If .Text = "Start Timer" Then
                Range("C" & lRow + 1) = Range("C" & lRow) + 1
                Range("D" & lRow + 1) = Format(Time, "h:mm:ss AM/PM;@")
                .Text = "Stop Timer"
            Else
                Range("E" & lRow) = Format(Time, "h:mm:ss AM/PM;@")
                s = Range("D" & lRow)
                e = Range("E" & lRow)
                Range("F" & lRow) = Format(e - s, "h:mm:ss")
                .Text = "Start Timer"
            End If
        End If
    End With
End Sub

Awesome Mumps.. Works as intended.... Thanks a million

I see a couple of macro's that you have created within and I dont see they being called. Could you please explain so I can learn from it.

 

[mumps]

You are very welcome. There are no other macros being called. Which lines of code are you referring to?

 

[Chefsohail]

You are very welcome. There are no other macros being called. Which lines of code are you referring to?

Hey Mumps thanx for the reply. There were a couple of codes in another module. I deleted that module.

I was wondering how to protect these cells so that they are not editable. What I am expecting is cell C4, D4, E4 and F4 and so on when entries are added using the button, the cells after adding the values should not be editable. Will you help me with that? Also wanted to understand if that is possible without protecting the sheet or workbook?

 

[mumps]

If you want to lock the cells, the sheet will have to be protected. Do the following:
First unlock all the cells in the sheet. To unlock all the cells, click on the upper left corner of the sheet just above the row number 1 and to the left of the header column A. This will select all the cells in the sheet. Then right click anywhere in the sheet and click "Format Cells". Click the "Protection" tab and remove the check mark in the box to the left of "Locked" and click "OK". Then try this macro. It will unprotect the sheet at the start and the protect it at the end. Change the password (two occurrences,in red) to suit your needs.

Sub ToggleMacro()
    Dim lRow As Long
    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim s As Date, e As Date
    ActiveSheet.Unprotect Password:="MyPassword"
    With ActiveSheet.Shapes("Button 2").TextFrame.Characters
        If lRow <= 3 Then
            If .Text = "Start Timer" Then
                Range("C4") = 1
                Range("D4") = Format(Time, "h:mm:ss AM/PM;@")
                .Text = "Stop Timer"
                Range("C4:D4").Locked = True
            Else
                Range("E4") = Format(Time, "h:mm:ss AM/PM;@")
                s = Range("D" & lRow)
                e = Range("E" & lRow)
                Range("F4") = Format(e - s, "h:mm:ss")
                .Text = "Start Timer"
                Range("E4:F4").Locked = True
            End If
        Else
            If .Text = "Start Timer" Then
                Range("C" & lRow + 1) = Range("C" & lRow) + 1
                Range("D" & lRow + 1) = Format(Time, "h:mm:ss AM/PM;@")
                .Text = "Stop Timer"
                Range("C" & lRow + 1).Resize(, 2).Locked = True
            Else
                Range("E" & lRow) = Format(Time, "h:mm:ss AM/PM;@")
                s = Range("D" & lRow)
                e = Range("E" & lRow)
                Range("F" & lRow) = Format(e - s, "h:mm:ss")
                .Text = "Start Timer"
                Range("E" & lRow + 1).Resize(, 2).Locked = True
            End If
        End If
    End With
    ActiveSheet.Protect Password:="MyPassword"
    ActiveSheet.EnableSelection = xlUnlockedCells
End Sub

 

[Chefsohail]

Hey Mumps,

Thanx a million again. Works as intended.. Just cell E4 remains unlocked. dont know why that happens.. But i am fine with one cell unlocked. Is not a challenge.

 

[mumps]

You are very welcome.