CODEWITHSUNDEEP
excelloopsdate
Joseph Knight
Joseph Knight

Reputation: 1

Excel VBA - Using for/to/step generate list of dates between start/stop dates

I have written a macro to expand a range of start/stop dates by 5 minute increments and assigning a "campaign" number to each set of dates. For example, I have a table of dates:

Start Stop
8/19/15 17:20 8/20/15 2:20
12/13/16 7:30 12/14/16 18:00
5/29/20 22:00 5/31/20 1:00

I want to expand each date range into a table at 5 minute increments (ie, 8/19/15 17:20, 8/19/15 17:25) then assign a label to each set (everything between 8/16/15 17:20 - 8/20/15 2:20 would be considered Campaign 1). I wrote the following code that works as planned, but when the macro gets to the 23:55 hour, the subsequent date is midnight of the previous day:

Date
8/19/15 23:50
8/19/15 23:55
8/19/15 00:00
8/20/15 00:05

Any thoughts on how to prevent the previous day showing up here?

Thanks

The code:

Sub campaignpull()

Dim ROWID As Integer
Dim LASTROW As Long
Dim rng As Range
Dim StartRng As Range
Dim EndRng As Range

ThisWorkbook.Sheets("Sheet1").Activate

LASTROW = ActiveSheet.UsedRange.Rows.Count

    For ROWID = 2 To LASTROW
        Set StartRng = Cells(ROWID, 1)
        Set EndRng = Cells(ROWID, 2)
        
            For i = StartRng To EndRng Step 1 / 24 / 12
            
            ThisWorkbook.Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = i
            ThisWorkbook.Sheets("Sheet2").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0) = ROWID - 1
            
            Next
 
            
        Next ROWID

End Sub

Upvotes: 0

Views: 253

Answers (2)

M.Sqrl
M.Sqrl

Reputation: 416

My take, although prior answer was good. Do as you like with columns:

Sub campaignpull()
    
    Dim rowId As Integer
    Dim lastRow As Long
    Dim rng As Range
    Dim currentTime As Date
    Dim endTime As Date
    Dim i As Date
    Dim rw As Integer
    
    Sheet1.Activate
    
    lastRow = ActiveSheet.UsedRange.Rows.Count
    
        For rowId = 2 To lastRow
            currentTime = Sheet1.Cells(rowId, 1).Value
            endTime = Sheet1.Cells(rowId, 2).Value
            rw = 1
            
            Do Until currentTime > endTime
                currentTime = currentTime + 1 / 24 / 12
                Sheet2.Cells(rw, rowId) = currentTime
                rw = rw + 1
            Loop
        Next rowId
End Sub

Upvotes: 0

ricardogerbaudo
ricardogerbaudo

Reputation: 432

it seems Excel handles Date/Time in a different way than VBA. The solution I found was to use Excel formulas to create the 5 minutes increments. Please take a look at the code below:

Sub CampaignPull()
    
    Dim rowCount As Integer
    rowCount = Evaluate("COUNTA(Sheet1!A:A)")
    
    Dim i As Integer
    Dim j As Integer
    j = 2
    Dim startDateTime As Date
    Dim endDateTime As Date
    
    For i = 2 To rowCount
        
        startDateTime = Sheets("Sheet1").Range("A" & i)
        endDateTime = Sheets("Sheet1").Range("B" & i)
        
        Sheets("Sheet2").Range("A" & j) = startDateTime
        
        Do
            j = j + 1
            Sheets("Sheet2").Range("A" & j).Formula = "=A" & (j - 1) & "+1/12/24"
        
        Loop While Sheets("Sheet2").Range("A" & j) <= endDateTime
    
    Next i
    
End Sub

Upvotes: 1

Related Questions