Add 1 hour to the cell

fraudit

New Member
Joined
Jan 14, 2015
Messages
11
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.:
Code:
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?
Code:
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
 
Last edited:

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Re: Add 1 hour to the cell - help needed

to add one hour you just need to add 1/24 to the cell
 
Upvote 0
Re: Add 1 hour to the cell - help needed

Change next to last line to and try...


Range("B2:B" & LastRow).Value = Range("B2:B" & LastRow).Value + (1/24)
 
Upvote 0
Re: Add 1 hour to the cell - help needed

I've already tried that and I'm also getting the same error - Type mismatch :(

I can easily achieve it by simply adding a next column and performing the action, then delete the original column, but I'd love to avoid this to speed up the macro execution.
 
Last edited:
Upvote 0
Re: Add 1 hour to the cell - help needed

try this

Code:
Sub CET_Time()
    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
End Sub
 
Upvote 0
Re: Add 1 hour to the cell - help needed

Code:
Sub CET_Time()
    Dim LastRow
    Dim ThisRow
    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 ThisRow = 2 To LastRow
        Range("B" & ThisRow).Value = Range("B" & ThisRow).Value + TimeSerial(1, 0, 0)
    Next ThisRow
End Sub

WBD
 
Upvote 0
Re: Add 1 hour to the cell - help needed

I don't think so but one of the moderator bods may know.
 
Upvote 0
Re: Add 1 hour to the cell - help needed

You could do it like this:

Code:
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("C2:C" & LastRow).Formula = "=B2+TIME(1,0,0)"
    Range("B2:B" & LastRow).Value = Range("C2:C" & LastRow).Value
    Range("C2:C" & LastRow).ClearContents
End Sub

WBD
 
Upvote 0
Re: Add 1 hour to the cell - help needed

Is there any way to perform such operation using range? Or do I have to use looping?
Code:
Sub CET_Time()
  Dim cell As Range
  
  Set cell = Cells(2, Columns.Count).End(xlToLeft).Offset(, 1)
  cell.Value = 1 / 24
  
  With Range("A2", Cells(Rows.Count, "A").End(xlUp))
    '.TextToColumns Destination:=Range("B2"), _
                   DataType:=xlFixedWidth, _
                   FieldInfo:=Array(Array(0, 1), Array(19, 9))
    cell.Copy
    .Offset(, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlPasteSpecialOperationAdd
  End With
  cell.Clear
End Sub
 
Upvote 0

Forum statistics

Threads
1,214,864
Messages
6,121,984
Members
449,058
Latest member
oculus

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top