I am trying to code a bit of VBA to compare a date from one column to the dates in another column. My code is:
Sub ForLoop()
Dim i As Integer
Dim j As Integer
Dim homenum As Integer
Dim dif As Long
Dim clockin As Long
Dim clockout As Long
For i = 2 To 18418
clockin = Cells(i, 4).Value
homenum = Cells(i, 5).Value
dif = 100
For j = 2 To 18418
clockout = Cells(j, 6).Value
If Cells(j, 5).Value = homenum & Abs((clockin - clockout) * 24 * 60) < Abs(dif) Then
dif = Abs((clockin - clockout) * 24 * 60)
End If
Next j
Cells(i, 9).Value = Abs(dif)
Next i
End Sub
Whenever I try to run this, Excel crashes, and I end up having to end the program from Task Manager. I can't find any reason for that in my code. Does anyone have any ideas?
A quick example of the input I'm working with:
This should be a lot faster - switched from cell-by-cell reads/writes to using arrays without changing your basic logic.
Sub ForLoop()
Dim i As Long, j As Long, homenum As Long 'prefer Long over Integer
Dim dif As Long, clockin As Long, clockout As Long
Dim ws As Worksheet, data, lr As Long, ub As Long, arrDiffs, d
Set ws = ActiveSheet 'always specify a worksheet, even if Activesheet...
lr = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row 'last-occupied row in E
data = ws.Range("D2:F" & lr).Value 'read all data as array
ub = UBound(data, 1) 'get "rows" upper bound
arrDiffs = ws.Range("I2:I" & lr).Value 'read dif column to array
For i = 1 To ub
clockin = data(i, 1) '1 = D
homenum = data(i, 2) '2 = E
dif = 100
For j = 1 To ub
If data(j, 2) = homenum Then
clockout = data(j, 3) '3 = F
d = Abs((clockin - clockout) * 24 * 60)
If d < dif Then dif = d
End If
Next j
arrDiffs(i, 1) = dif 'update diff array
Next i
ws.Range("I2:I" & lr).Value = arrDiffs 'write all diffs back to sheet
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.