Recording competitor times in mm:ss.00 help with VBA code

[epasccm]

Hi I am reasonably inexperienced with complex excel issues.
I am a member of a motorsport club who has an upcoming event on saturday (yes only in a few days time!!) and I have a spreadsheet that isn't doing what I need it to, to record our competitors times!
The format of the event it that there are 3 tracks and each of the 30 drivers have 3 goes at each track. Only their fast time from each track gets added together to come up with their total score.
My current spreadsheet did work perfectly if I only needed to account for minutes and seconds but I really need it to include the hundredth's of a second (mm:ss.00)

I had a go at VBA (for the first time - didn't know this existed) using a code I found while searching the internet and it was working (but for some unknown reason it no longer is?????)

This was the code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Intrsct As Range, Cell As Range, s As String
Dim mins As Long, secs As Long, t As Date

Set Intrsct = Intersect(Range("I6:J35,L6:M35,O6:P35,S6:T35,V6:W35,Y6:Z35,AC6:AD35,AF6:AG35,AI6:AJ35,AM6:AN35,AP6:AQ35,AS6:AT35"), Target)
If Intrsct Is Nothing Then Exit Sub

Application.EnableEvents = False
For Each Cell In Intrsct
s = Cell.Text
If s = "" Then
Cell.NumberFormat = "@"
ElseIf Len(s) > 4 Then
Cell.Clear
Cell.NumberFormat = "@"
Else
s = Right("0000" & s, 4)
If s Like "####" Then
mins = CLng(Left(s, 2))
secs = CLng(Right(s, 2))
t = TimeSerial(0, mins, secs)
Cell.NumberFormat = "[mm]:ss"
Cell.Value = t
Else
Cell.Clear
Cell.NumberFormat = "@"
End If
End If
Next Cell
Application.EnableEvents = True
End Sub

But like I said it didn't work for hundredth's of a second.

Question 1: can this be modified to include hundredth's of a second, mm:ss.00 if so please show me how.
Question 2: is there a completely better way?
Question 3: why did it stop working today when every other time I have opened the spreadsheet it was fine - is there a setting that I need to change?

 

[Crystalyzer]

Can you post a copy of your data using the XL2BB tool? See signature for instructions.

 

[Crystalyzer]

Question 1: can this be modified to include hundredth's of a second, mm:ss.00 if so please show me how.

Yes, I modified the number format so that it will include hundredths and expanded the lines "ElseIf Len(s) > 6 Then" and "s = Right("000000" & s, 6)" from 4 to 6 and changed "If s Like "######" Then" to include two more digits

Question 2: is there a completely better way?

I hope the code below is better. I removed the Loop and replaced the Cell variable with Target since you are only ever changing one cell which is the Target despite the loop. (i.e. the loop only fires once if Intrsct is not nothing)

Question 3: why did it stop working today when every other time I have opened the spreadsheet it was fine - is there a setting that I need to change?

Is it possible that you encountered an issue somewhere along the way and stopped the execution of the macro before it ended? If so, the Application.EnableEvents is still set to FALSE. You can run the code below to fix that.

Code to turn on Events

Sub x()
Application.EnableEvents = True
End Sub

Revised Code for hundredths

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Intrsct As Range, Cell As Range, s As String
    Dim mins As String, secs As String
    
    Set Intrsct = Intersect(Range("I6:J35,L6:M35,O6:P35,S6:T35,V6:W35,Y6:Z35,AC6:AD35,AF6:AG35,AI6:AJ35,AM6:AN35,AP6:AQ35,AS6:AT35"), Target)
    
    If Intrsct Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    
    For Each Cell In Intrsct
        s = Cell.Text
        If s = "" Then
            Cell.NumberFormat = "@"
        ElseIf Len(s) > 6 Then
            Cell.Clear
            Cell.NumberFormat = "@"
        Else
            s = Right("000000" & s, 6)
            If s Like "######" Then
                mins = Left(s, 2)
                secs = Mid(s, 3, 2) & "." & Right(s, 2)
                Cell.NumberFormat = "[mm]:ss.00"
                Cell.Value = mins & ":" & secs
            Else
                Cell.Clear
                Cell.NumberFormat = "@"
            End If
        End If
    Next Cell
    
    Application.EnableEvents = True
    
End Sub

 

[epasccm]

example.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK
1
2
3									Test 1										Test 2										Test 3
4									Run 1			Run 2			Run 3				Run 1			Run 2			Run 3				Run 1			Run 2			Run 3
5	#	Name	TOTAL	Test 1	Test 2	Test 3	Test 4		Time	Penalty	Total	Time	Penalty	Total	Time	Penalty	Total		Time	Penalty	Total	Time	Penalty	Total	Time	Penalty	Total		Time	Penalty	Total	Time	Penalty	Total	Time	Penalty	Total
6	1	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
7	2	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
8	3	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
9	4	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
10	5	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
11	6	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
12	7	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
13	8	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
14	9	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
15	10	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
16	11	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
17	12	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
18	13	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
19	14	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
20	15	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
21	16	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
22	17	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
23	18	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
24	19	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
25	20	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
26	21	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
27	22	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
28	23	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
29	24	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
30	25	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
31	26	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
32	27	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
33	28	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
34	29	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
35	30	driver name	00:00	00:00	00:00	00:00	00:00				00:00			00:00			00:00				00:00			00:00			00:00				00:00			00:00			00:00
36
37								Slowest times			Test 1	00:00									Test 1	00:00									Test 1	00:00
Timesheet

Cell Formulas
Range	Formula
C6:C35	C6	=SUM(D6:G6)
D6:D35	D6	=MINA(K6,N6,Q6)
E6:E35	E6	=MINA(U6,X6,AA6)
F6:F35	F6	=MINA(AE6,AH6,AK6)
G6:G35	G6	=MINA(AO6,AR6,AU6)
AK6:AK35,AH6:AH35,AE6:AE35,AA6:AA35,X6:X35,U6:U35,Q6:Q35,N6:N35,K6:K35	K6	=SUMPRODUCT(I6+J6)
L37,AF37,V37	L37	=MAXA(I6:I35,L6:L35,O6:O35)

 

[epasccm]

Yes, I modified the number format so that it will include hundredths and expanded the lines "ElseIf Len(s) > 6 Then" and "s = Right("000000" & s, 6)" from 4 to 6 and changed "If s Like "######" Then" to include two more digits


I hope the code below is better. I removed the Loop and replaced the Cell variable with Target since you are only ever changing one cell which is the Target despite the loop. (i.e. the loop only fires once if Intrsct is not nothing)

Is it possible that you encountered an issue somewhere along the way and stopped the execution of the macro before it ended? If so, the Application.EnableEvents is still set to FALSE. You can run the code below to fix that.

Code to turn on Events

Sub x()
Application.EnableEvents = True
End Sub

Revised Code for hundredths

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Intrsct As Range, Cell As Range, s As String
    Dim mins As String, secs As String
   
    Set Intrsct = Intersect(Range("I6:J35,L6:M35,O6:P35,S6:T35,V6:W35,Y6:Z35,AC6:AD35,AF6:AG35,AI6:AJ35,AM6:AN35,AP6:AQ35,AS6:AT35"), Target)
   
    If Intrsct Is Nothing Then Exit Sub
   
    Application.EnableEvents = False
   
    For Each Cell In Intrsct
        s = Cell.Text
        If s = "" Then
            Cell.NumberFormat = "@"
        ElseIf Len(s) > 6 Then
            Cell.Clear
            Cell.NumberFormat = "@"
        Else
            s = Right("000000" & s, 6)
            If s Like "######" Then
                mins = Left(s, 2)
                secs = Mid(s, 3, 2) & "." & Right(s, 2)
                Cell.NumberFormat = "[mm]:ss.00"
                Cell.Value = mins & ":" & secs
            Else
                Cell.Clear
                Cell.NumberFormat = "@"
            End If
        End If
    Next Cell
   
    Application.EnableEvents = True
   
End Sub

I have included your suggested changes as above but it doesn't seem to be working when I enter an amount in the cell. For example if I type 123456 I would like it to be 12:34.56 but it is such coming up as 123456. - any suggestions??? thanks for your time on this it is appreciated!

 

[Crystalyzer]

I think you have to copy the code that i provided and use it and also you will have to run the macro below to re-enable the events

Sub x()
Application.EnableEvents = True
End Sub

 

[Crystalyzer]

With your data and my macro, I entered 123456 in I6 and got the following:

epasccm 20210804.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1
2
3									Test 1
4									Run 1			Run 2			Run 3
5	#	Name	TOTAL	Test 1	Test 2	Test 3	Test 4		Time	Penalty	Total	Time	Penalty	Total	Time	Penalty	Total
6	1	driver name	0	0	0	0	0		12:34.56		0.008733			0			0
7	2	driver name	0	0	0	0	0				0			0			0
8	3	driver name	0	0	0	0	0				0			0			0
9	4	driver name	0	0	0	0	0				0			0			0
Sheet2

Cell Formulas
Range	Formula
C6:C9	C6	=SUM(D6:G6)
D6:D9	D6	=MINA(K6,N6,Q6)
E6:E9	E6	=MINA(U6,X6,AA6)
F6:F9	F6	=MINA(AE6,AH6,AK6)
G6:G9	G6	=MINA(AO6,AR6,AU6)
K6:K9,Q6:Q9,N6:N9	K6	=SUMPRODUCT(I6+J6)

 

[Crystalyzer]

Sorry the code I posted above still included the loop but that is the only difference. Here is the code with the loop taken out since it really doesn't do anything.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Intrsct As Range, s As String
    Dim mins As String, secs As String
    
    Set Intrsct = Intersect(Range("I6:J35,L6:M35,O6:P35,S6:T35,V6:W35,Y6:Z35,AC6:AD35,AF6:AG35,AI6:AJ35,AM6:AN35,AP6:AQ35,AS6:AT35"), Target)
    
    If Intrsct Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    
    s = Target.Text
    If s = "" Then
        Target.NumberFormat = "@"
    ElseIf Len(s) > 6 Then
        Target.Clear
        Target.NumberFormat = "@"
    Else
        s = Right("000000" & s, 6)
        If s Like "######" Then
            mins = Left(s, 2)
            secs = Mid(s, 3, 2) & "." & Right(s, 2)
            Target.NumberFormat = "[mm]:ss.00"
            Target.Value = mins & ":" & secs
        Else
            Target.Clear
            Target.NumberFormat = "@"
        End If
    End If
    
    Application.EnableEvents = True
    
End Sub

 

[epasccm]

I think you have to copy the code that i provided and use it and also you will have to run the macro below to re-enable the events

Sub x()
Application.EnableEvents = True
End Sub

THANK YOU SO MUCH!!!