How to modify date when copying using a macro?

Question

I am writing a macro in VBA. I have a loop that goes through a list of dates and every entry where the minute is 00,15.30.45 it copies the date and time into a new column. This is only part of the code I am working on so that is why it seems pointless at the moment. My trouble is I need to modify the time that is copied into the new column. I need the date to stay the same but the time must be modified so that:

hh:00 becomes   hh-1:45
hh:15 becomes   hh  :00
hh:30 becomes   hh  :15
hh:45 becomes   hh  :30

I have below the current code that I have and everything works except obviously it does not modify the time because I just made that up to make sense of what I want to do. What code do I need to modify the hour and minute? Thanks!

Dim X As Integer

Range("A2").Select
NumRows = Range(Selection, Selection.End(xlDown)).Rows.Count
Range("A2").Select

For X = 2 To NumRows
    If (Minute(ActiveCell.Value) = 0) Then
        Range("D2").Value = ActiveCell.Value
        Range("D2").NumberFormat = "YYYY-MM-DD HH-1:45"
    ElseIf (Minute(ActiveCell.Value) = 15) Then
        Range("D2").Value = ActiveCell.Value
        Range("D2").NumberFormat = "YYYY-MM-DD HH:00"        
    ElseIf (Minute(ActiveCell.Value) = 30) Then
        Range("D2").Value = ActiveCell.Value
        Range("D2").NumberFormat = "YYYY-MM-DD HH:15" 
    ElseIf (Minute(ActiveCell.Value) = 45) Then
        Range("D2").Value = ActiveCell.Value
        Range("D2").NumberFormat = "YYYY-MM-DD HH:30"
    End If

    Selection.Offset(1, 0).Select
Next X

Answer 1

I'm at a bar-b-que (Happy 4th of JULY EVERYONE) and this seems way more interesting than the guests that are here.

So to add time like you know inutes, you should probably use the TimeSerial Function. I tried to modify your code to do what you said, but truthfully it's hard during a bar-b-Q.

A couple suggestions.

1. Don't use select
2. Don't use Integer
3. To add 4 hours 3 minutes and 8 seconds to a date.... TimeSerial(4, 3, 8)

Here's how I tried to change your code to get what you want. You should be able to extrapolate what I meant.

Sub Running_From_That_Water_Like_My_Name_Was_TedKennedy()

Dim X As Long, WSheet As Worksheet, increaseAMOUNT As Double


Set WSheet = ActiveSheet '<---- make sure this is correct

With WSheet


Dim aCell As Range: Set aCell = .Range("A2")
Dim increaseAMOUNT As Double: increaseAMOUNT = TimeSerial(0, 15, 0) 'this adds `15 minutes



For X = 2 To Range(Range("A2"), Range("A2").End(xlDown)).Rows.Count


    If (Minute(ActiveCell.Value) = 0) Then

    Range("D2").Value = aCell.Value + increaseAMOUNT '<----you can modify the amount to increase consistently or include your own TimeSerial
    Range("D2").NumberFormat = "YYYY-MM-DD HH-1:45"


    ElseIf (Minute(aCell.Value) = 15) Then
    Range("D2").Value = aCell.Value + increaseAMOUNT
    Range("D2").NumberFormat = "YYYY-MM-DD HH:00"

    ElseIf (Minute(aCell.Value) = 30) Then
   Range("D2").Value = aCell.Value + increaseAMOUNT
    Range("D2").NumberFormat = "YYYY-MM-DD HH:15"

    ElseIf (Minute(aCell.Value) = 45) Then
    Range("D2").Value = aCell.Value + increaseAMOUNT
    Range("D2").NumberFormat = "YYYY-MM-DD HH:30"


    End If



    Set aCell = aCell.Offset(1, 0)

    Next X
End With


End Sub
'People-I-know.Girls.Count = 0