Time + 15 minutes & repeat

[Luke777]

Hi all,

I'm using the following code.

Sub Time()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim sdt As Date
Dim rng As Range

Set ws1 = Worksheets(7)
Set rng = ws2.Range("A4")

sdt = ws1.Range("K1").Value

rng.Value = sdt

End Sub

It grabs a date with time from ws1 K1 and places it in ws2 A4. K1 is formatted like "06/01/2022 11:30".

How can I get the code to loop round and add 15 minutes for each cell in A? For example, A5 would show "06/01/2022 11:45", A6 would be "06/01/2022 12:00" and, importantly, A99 would be "07/01/2022 06:15" (23 hours an 45 minutes from the start date and time).

I should note, the times I have given are all just examples so using the NOW function won't be useful. The date and time in ws1 K1 are variable

Thanks!

 

[Luke777]

Hi all,

I'm using the following code.

Sub Time()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim sdt As Date
Dim rng As Range

Set ws1 = Worksheets(7)
Set rng = ws2.Range("A4")

sdt = ws1.Range("K1").Value

rng.Value = sdt

End Sub

It grabs a date with time from ws1 K1 and places it in ws2 A4. K1 is formatted like "06/01/2022 11:30".

How can I get the code to loop round and add 15 minutes for each cell in A? For example, A5 would show "06/01/2022 11:45", A6 would be "06/01/2022 12:00" and, importantly, A99 would be "07/01/2022 06:15" (23 hours an 45 minutes from the start date and time).

I should note, the times I have given are all just examples so using the NOW function won't be useful. The date and time in ws1 K1 are variable

Thanks!

I should probably have said, I'm aware that what I have written so far is a complicated way of doing what it currently does - but I'm expecting the solution to extend the rng variable to cover A4:A99 and then maybe use For Each? I'm a bit lost when it comes to creating code like that

 

[Saurabhj]

Hi Luke,

Check below code.

Sub Time()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim sdt As Date
Dim rng As Range, rowno As Integer

Set ws1 = Worksheets(7)
'Set ws2 = Sheets("Sheet2")
Set rng = ws2.Range("A4")

sdt = ws1.Range("K1").Value

For rowno = 4 To 10
    rng.Value = sdt
    sdt = sdt + (15 / 60 / 24)
    Set rng = rng.Offset(1, 0)
Next

End Sub

 

[Luke777]

Hi Luke,

Check below code.

Sub Time()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim sdt As Date
Dim rng As Range, rowno As Integer

Set ws1 = Worksheets(7)
'Set ws2 = Sheets("Sheet2")
Set rng = ws2.Range("A4")

sdt = ws1.Range("K1").Value

For rowno = 4 To 10
    rng.Value = sdt
    sdt = sdt + (15 / 60 / 24)
    Set rng = rng.Offset(1, 0)
Next

End Sub

Works nicely! Thank you very much