# Splitting date and time

I asked a question on Stack OverFlow and I got an answer to my question but then I found out the program is crashing because I have 250k data points on my Excel sheet. I was wondering what I can do to make it so it won’t crash. I'm hoping I can understand what I can do to improve the code.

Sub CompareTime()

Dim ws As Worksheet

Dim lastRow As Long
Dim Count As Long
Dim test As Double

Set ws = ActiveSheet

'Find last data point
With ws
.Columns(2).Insert
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For Count = 5 To lastRow
'split date
test = .Cells(Count, 1).Value2
.Cells(Count, 1).Value2 = Int(test)
.Cells(Count, 1).NumberFormat = "m/d/yyyy"
.Cells(Count, 1).Offset(0, 1).Value2 = test - Int(test)
.Cells(Count, 1).Offset(0, 1).NumberFormat = "hh:mm AM/PM"

Next Count
End With

End Sub


• Just to be sure we are not missing something simple --- why couldn't you have done this with just a DATEVALUE and TIMEVALUE formula, instead of writing VBA code? – this Dec 28 '17 at 21:55
• @this So I will have 2 documents, and I need to match time between these 2 documents and combine them into 1 document, im currently trying to do the compare 2 document with same timestamp and match them part. – barooon gara Dec 28 '17 at 22:09
• That doesn’t really answer the question. You can do lookups across documents. – RubberDuck Dec 28 '17 at 23:30
• May I ask why you need to split it into Date and Time for comparing with another file? Load the ranges' Value2 into arrays and compare in memory should be a lot faster, no adding columns needed. – PatricK Jan 4 '18 at 22:47

Turning off Application.ScreenUpdating and Application.Calculation will greatly increase the speed. But reading the data into an Array, modifying it and writing the Array back to the Worksheet is the real key to speed.

Sub CompareTime()
'Optimize Setting for faster data writing
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With

Dim Target As Range, ws As Worksheet
Dim x As Long
Dim results As Variant

Set ws = ActiveSheet

'Find last data point
With ws
.Columns("B:C").Insert
.Columns("B:B").NumberFormat = "mm/dd/yy;@"
.Columns("C:C").NumberFormat = "h:mm:ss;@"

Set Target = .Range("A5", .Cells(.Rows.Count, "A").End(xlUp)).Resize(, 3)
results = Target.Value2

For x = 1 To UBound(results)
results(x, 2) = Int(results(x, 1))
results(x, 3) = results(x, 1) - results(x, 2)
Next

Target.Value2 = results
End With

With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub


Set Target = .Range("A5", .Cells(.Rows.Count, "A").End(xlUp)).Resize(, 3)

## Code Explaination

• .Cells(.Rows.Count, "A").End(xlUp)
• Target the last non-empty cell in Column A
• .Range("A5", .Cells(.Rows.Count, "A").End(xlUp))
= Target Range from A5 to last non-emtpy cell in Column A
• .Resize(, 3) = Resize the Target range to include 2 more Column to the right same number of rows

• results = Target.Value2

• Create an array of values from the Target range.
• .Value 2 is more effiecent than .Value because it ignores formatting
• Target.Value2 = results

• Assign the modified values from the results Array back to the Target range.
• Hey thank you so much! I never knew I could turn off the Screenupdate and stuff. In the future I will just put data in array and modify it there, as that seems like what everyone recommends. Can you write a littile bit of comments for me so that I can follow along on what exactly is going on, im still new so Its hard for me to follow along. – barooon gara Dec 29 '17 at 16:48

Based on what your end goal in comment (please Edit post next time), I have 2 different approaches without adding columns to do comparison. Assuming you want to compare 2 data sets A & B, and only interested when time stamps match.

Please do add the ScreenUpdate; change Calculation mode to optimise further. Would love to hear the performance difference between the two.

(1) Load them into memory as two Arrays for comparison (slower):

Sub CompareTimeStamp()' SLOWER
Dim aTimeStampA As Variant, lLastRowA As Long ' For dataset A
Dim aTimeStampB As Variant, lLastRowB As Long ' For dataset B
Dim i As Long, j As Long ' Counters

' Assuming data on 2 different sheets in the SAME FILE here:
lLastRowA = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
lLastRowB = ThisWorkbook.Worksheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row

aTimeStampA = ThisWorkbook.Worksheets("Sheet1").Range("A5:A" & lLastRowA).Value2
aTimeStampB = ThisWorkbook.Worksheets("Sheet2").Range("A5:A" & lLastRowB).Value2

' Check if time stamps in set B is in A:
For j = LBound(aTimeStampB, 1) To UBound(aTimeStampB, 1)
For i = LBound(aTimeStampA, 1) To UBound(aTimeStampA, 1)
If aTimeStampB(j, 1) = aTimeStampA(i, 1) Then
Debug.Print "Set B row " & j + 4 & " (" & Format(aTimeStampB(j, 1), "mm/dd/yyyy hh:mm:ss AM/PM") & ") matches Set A row " & i + 4
Exit For
End If
Next i
Next j
End Sub


(2) Load to memory using Array and compare using Dictionary Object:

Sub CompareTimeStamp2() ' FASTER
Dim aTimeStamp As Variant, lLastRow As Long
Dim i As Long ' Counter
Dim oDict As Object ' Scripting.Dictionary (Windows only)

' Assuming data on 2 different sheets in the SAME FILE here:
' Set A on Sheet1, this workbook with the macro
lLastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
aTimeStamp = ThisWorkbook.Worksheets("Sheet1").Range("A5:A" & lLastRow).Value2

Set oDict = CreateObject("Scripting.Dictionary")
' Put value2 from set A to Dictionary - Assumed timestamps in a set are unique
For i = LBound(aTimeStamp, 1) To UBound(aTimeStamp, 1)
oDict.Add aTimeStamp(i, 1), i ' Value of this key refers to n'th item in Set A (starts from 1)
DoEvents
Next i

' Check if timestamps on Set B matches any of set A
' Set B on Sheet2, change this to your other doc to compare
lLastRow = ThisWorkbook.Worksheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
aTimeStamp = ThisWorkbook.Worksheets("Sheet2").Range("A5:A" & lLastRow).Value2
For i = LBound(aTimeStamp, 1) To UBound(aTimeStamp, 1)
If oDict.Exists(aTimeStamp(i, 1)) Then
Debug.Print Format(aTimeStamp(i, 1), "mm/dd/yyyy hh:mm:ss AM/PM"), "Set B (" & i & ") matched on Set A (" & oDict(aTimeStamp(i, 1)) & ")"
' Transfer data from Set B to Set A's other column (add 4 to get correct row number on worksheet, since start from 5)
End If
DoEvents
Next i

oDict.RemoveAll
Set oDict = Nothing
End Sub