vba - How to list all dates by every 2 hours between two given dates in Excel

Question

In my work I have to deal with Excel tables and gather data between time ranges.

Till now I used the following VBA code:

Sub WriteDates()
'Updateby20150305
Dim rng As Range
Dim StartRng As Range
Dim EndRng As Range
Dim OutRng As Range
Dim StartValue As Variant
Dim EndValue As Variant
xTitleId     = "KutoolsforExcel"
Set StartRng = Application.Selection
Set StartRng = Application.InputBox("Start Range (single cell):", xTitleId, StartRng.Address, Type: = 8)
Set EndRng   = Application.InputBox("End Range (single cell):", xTitleId, Type: = 8)
Set OutRng   = Application.InputBox("Out put to (single cell):", xTitleId, Type: = 8)
Set OutRng   = OutRng.Range("A1")
StartValue   = StartRng.Range("A1").Value
EndValue     = EndRng.Range("A1").Value
If EndValue - StartValue <= 0 Then
    Exit Sub
    End If
    ColIndex = 0
    For i = StartValue To EndValue
        OutRng.Offset(ColIndex, 0) = i
        ColIndex = ColIndex + 1
    Next
End Sub

But this code allows only to list whole days and not by hours.

For example if I enter date range between 01.01.2017 and 03.01.2017 => to list 01.01.2017 02:00, then 01.01.2017 04:00 and so on ... to 02.01.2017 22:00.

I tried a few times to edit this code but I just broke it every time. I also tried to remove the Inputboxes so that the code to reads from Cells B2 and C2 the time range and in A17 to be the output but again no success.

I am not a programmer so I tried by reading a bit about VBA but I understood that is needed to learn a lot.

If someone has tried this or knows how to help I will be very grateful.

Answer 1

The code you have is using the for loop "For i = StartValue To EndValue" to generate the values so there is nowhere to enter your 2 hour interval. My code uses the endDate and startDate to calculate how many rows you will need by multiplying by endDate-startDate by 12. if the interval was not as easy to calculate e.g. 3 hours then you could change the for loop to a while loop that checks if the value has reached the endDate.

Sub WriteDates()
'Updateby20150305
Dim rng As Range
Dim StartRng As Range
Dim EndRng As Range
Dim OutRng As Range
Dim StartValue As Variant
Dim EndValue As Variant
xTitleId = "KutoolsforExcel"
Set StartRng = Application.Selection
Set StartRng = Application.InputBox("Start Range (single cell):", xTitleId, StartRng.Address, Type:=8)
Set EndRng = Application.InputBox("End Range (single cell):", xTitleId, Type:=8)
Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)
Set OutRng = OutRng.Range("A1")
StartValue = StartRng.Range("A1").Value
EndValue = EndRng.Range("A1").Value
If EndValue - StartValue <= 0 Then
    Exit Sub
    End If
    ColIndex = 0
    intRows = (EndValue - StartValue) * 12 ' number of times you need to loop to get 2 hour intervals 24/2
    OutRng.Offset(0, 0) = StartValue ' put start value in the range
    OutRng.Offset(0, 0).NumberFormat = "dd/mm/yyyy hh:mm" 'set the format
    For RowIndex = 1 To intRows ' loop from 1 to intRows
        OutRng.Offset(RowIndex, 0) = OutRng.Offset(RowIndex - 1, 0) + CDate("02:00:00") 'put the value above + 2 hours
        OutRng.Offset(RowIndex, 0).NumberFormat = "dd/mm/yyyy hh:mm" ' set the format so that you can see the hours
    Next
End Sub

You can also use a formula in excel. Put your duration in cell A1 (02:00) then put your start date in B1 (01/02/2017) and your end date in B2 (01/03/2017) then in B6 enter =B1 and in B7 =IFERROR(IF(B6+$A$1<=$B$2,B6+$A$1,""),"") autofill B7 down as far as you think you'll need for your list or much more to be safe. Now when you change anything in A1, B1 or B2, your list will automatically update.