Hi,
Basic problem:
I want to loop through every minute of a date/time range as fast as possible.
For example,
Start Date: 7/9/15 8:00 PM
End Date: 7/10/15 8:00 AM
The code should go through 8:01 PM, 8:02 PM, 8:03 PM, etc. until the end date/time.
Here's the context:
I have a spreadsheet that pulls in values based on an entered date and time.
Two cells perform calculations on those values and give that date/time an assigned number, either a 0 or 2.
I want the macro to go through every minute in a date range and when the assigned numbers of the two cells do not match, to copy and paste the date in either column 1 or column 2.
Here is the code I have:
This works, but it iterates slowly, I can watch the minute increase when ideally I'd like it to be close to instantaneous.
I tried looking into For...Next loops but didn't make much progress.
Any help would be greatly appreciated!
Sub Cycle()
Dim i As Integer
Dim j As Integer
Dim k As Integer
i = 0
j = 3
k = 3
'F1 is the date that calculations are based on
'P7 is the given start date/time
Range("F1").Value = Range("P7").Value
'Q7 is the end date/time
Do Until Range("F1").Value >= Range("Q7").Value
Range("F1").Value = Range("P7").Value + (i / 1440) 'this is to convert the day to a minute step-size
'O2 and O15 are the two calculated cells with either a 0 or 2 assigned
If Range("O2").Value = 0 And Range("O15").Value = 2 Then
'Pasting the date into the column
Range("F1").Copy
Cells(j, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = "m/d/yy h:mm;@"
j = j + 1
ElseIf Range("O2").Value = 2 And Range("O15").Value = 0 Then
Range("F1").Copy
Cells(k, 3).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = "m/d/yy h:mm;@"
k = k + 1
Else
End If
i = i + 1
Loop
End Sub
Thanks
Bookmarks