CODEWITHSUNDEEP
vbaexcel
mikolajek
mikolajek

Reputation: 91

VBA - add 1 hour the a range

I'm getting some time & date values in the UTC time - they look like this yyyy-mm-dd HH:mm:ss:fff UTC, e.g.:

2018-07-13 10:01:11.427 UTC
2018-07-13 10:01:10.612 UTC
2018-07-13 10:01:03.931 UTC
2018-07-13 10:00:58.201 UTC
2018-07-13 10:00:55.298 UTC

I'm using text to columns to cut off the UTC part and I need to convert the resulting date & time into CET, so I simply need to add one hour to it.

I've come up with the following code but it fails to work. Could anyone help me to solve this?

Sub CET_Time()
    Dim LastRow 
    LastRow = ActiveSheet.UsedRange.Rows.Count
    With Range("A2:A" & LastRow)
        .TextToColumns Destination:=Range("B2"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(19, 9)), TrailingMinusNumbers:=True
    End With
    Range("B2:B" & LastRow).Value = DateAdd("h", 1, Range("B2:B" & LastRow).Value)
End Sub

Upvotes: 1

Views: 707

Answers (4)

Scott Craner
Scott Craner

Reputation: 152505

Nothing wrong with loops, but I like arrays:

Sub CET_Time()
    Dim LastRow As Long
    LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    With ActiveSheet.Range("A2:A" & LastRow)
        .Offset(, 1).Value = ActiveSheet.Evaluate("INDEX(left(" & .Address(1, 1) & ",23)+1/24,)")
        .Offset(, 1).NumberFormat = "YYYY-MM-DD HH:MM:SS.000"
    End With
End Sub

If you just want to overwrite in place remove both .Offset( ,1)

Upvotes: 1

JNevill
JNevill

Reputation: 50034

As @Tom suggests you may have luck looping through your range since DateAdd takes a date as the third parameter and right now you are passing it a Range which is a totally different type.

For Each rngCell in Range("B2:B" & LastRow)
    rngCell.value = DateAdd("h", 1, rngCell.Value)
Next rngCell

This still may fail since it's bening passed a string instead of a date, but it may work as-is without any further tinkering (haven't tested).

Just tested, you will almost definitely need to convert that date string into date. You can use cdate() to do this: 

For Each rngCell in Range("B2:B" & LastRow)
    rngCell.value = DateAdd("h", 1, cdate(rngCell.Value))
Next rngCell

Upvotes: 3

TinMan
TinMan

Reputation: 7759

The easiest thing to do is write a function that increment the value for you.

enter image description here

Sub CET_Time2()
    Dim cell As Range
    Dim results As Variant
    With ActiveSheet
        For Each cell In .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
            If cell.value Like "####-##-## ##:##:##.### UTC" Then
                cell.Offset(0, 2).value = getUTCTime1Hour(cell.value)
            End If
        Next
    End With
End Sub

Function getUTCTime1Hour(value As Variant) As String
    Dim d As Date
    If value Like "####-##-## ##:##:##.### UTC" Then
        d = DateValue(Left(value, 16)) + TimeValue(Left(value, 16))
        d = d + TimeSerial(1, 0, 0)
        getUTCTime1Hour = Format(d, "YYYY-MM-DD HH:MM") & Right(value, 8)
    End If
End Function

Upvotes: 0

mikolajek
mikolajek

Reputation: 91

I've got this suggestion and it does the job:

Dim LastRow As Long
Dim RLoop As Long
LastRow = ActiveSheet.UsedRange.Rows.Count
With Range("A2:A" & LastRow)
    .TextToColumns Destination:=Range("B2"), DataType:=xlFixedWidth, _
    FieldInfo:=Array(Array(0, 1), Array(19, 9)), TrailingMinusNumbers:=True
End With
For RLoop = 2 To LastRow
If IsDate(Range("B" & RLoop).Value) Then
Range("B" & RLoop).Value = DateAdd("h", 1, Range("B" & RLoop).Value)
End If
Next RLoop

Still I'd love to know if I can achieve the same by using range - I'm much more comfortable with this than with looping...

Upvotes: 0

Related Questions