Sub Tester()
' Storing the base time
Dim myArray1(1 To 31) As Variant
' Storing the Names
Dim myArray2(1 To 31) As Variant
'Storing the Guess
Dim myArray3(1 To 31) As Variant
'Storing the diff between guess and actual
Dim myArray4(1 To 31) As Double
Dim TrimResult As String
Dim NewResult As Double
BaseRow = 3
For m = 1 To 31
GuessCol = 3
NameRow = 2
CheckCol = 3
For i = 1 To 31
myArray1(i) = Cells(BaseRow, 2).Value
myArray2(i) = Cells(NameRow, CheckCol).Value
myArray3(i) = Cells(BaseRow, GuessCol).Value
Sheets("Sheet2").Cells(i, 1) = myArray1(i)
Sheets("Sheet2").Cells(i, 2) = myArray2(i)
Sheets("Sheet2").Cells(i, 3) = myArray3(i)
CheckCol = CheckCol + 1
GuessCol = GuessCol + 1
myArray4(i) = DateDiff("h", myArray1(i), myArray3(i)) + DateDiff("m", myArray1(i), myArray3(i)) + DateDiff("s", myArray1(i), myArray3(i))
Sheets("Sheet2").Cells(i, 4) = myArray4(i)
TrimResult = Sheets("Sheet2").Cells(i, 4)
NewResult = Replace(TrimResult, "-", "")
Sheets("Sheet2").Cells(i, 5) = NewResult
Next i
Sheets("Sheet2").Activate
Sheets("Sheet2").Range("E1:E31").Copy
Range("F1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("E1:E32") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet2").Sort
.SetRange Range("A1:G32")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Dim myArray5(1 To 31, 2 To 6) As String
Dim Winner As String
ResultRow = 1
For h = 1 To 31
PostResult = 9
For j = 2 To 6
myArray5(h, j) = Sheets("Sheet2").Cells(h, j)
Sheets("Sheet2").Cells(h, PostResult) = myArray5(h, j)
Sheets("Sheet2").Cells(h, 8) = myArray5(h, 2) & " - " & Format(myArray5(h, 3), "hh:mm:ss") & " - " & myArray5(h, 6)
PostResult = PostResult + 1
Next j
Winner = Sheets("Sheet2").Cells(h, 8).Text
If Sheets("Sheet2").Cells(1, 14).Value = "" Then
Sheets("Sheet2").Cells(1, 14).Value = Winner
Else
Sheets("Sheet2").Cells(1, 14).Value = Winner & vbNewLine & Sheets("Sheet2").Cells(1, 14).Value
End If
Sheets("Sheet2").Cells(h, 10).Value = Format(Sheets("Sheet2").Cells(h, 10), "hh:mm:ss")
If Sheets("Sheet2").Range("F" & ResultRow) <> Sheets("Sheet2").Range("F" & ResultRow + 1) Then
Exit For
End If
ResultRow = ResultRow + 1
Next h
Sheets("Sheet1").Range("AH" & BaseRow) = Trim(Sheets("Sheet2").Range("N1").Text)
Sheets("Sheet1").Activate
Range("AH" & BaseRow).Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
BaseRow = BaseRow + 1
Sheets("Sheet2").Cells.Delete
Sheets("Sheet1").Activate
Next m
End Sub