VBA Text To Columns not fully applying 24hr format to time

124 Views Asked by At

Morning all,

I've got the below section of code which doesn't seem to want to convert the time element of column A into 24hr. The data is in original format dd/mm/yyyy hh:mm:ss. Every time after midday is being displayed in 12hr format i.e. 14:12 is shown as 02:12

(the deleting of rows and columns doesn't relate to the text to columns process but is included in the segment below)

With ActiveSheet
    .Rows("1:5").delete Shift:=xlUp
    .Range("F:F,N:N,O:O,P:P,S:S,U:U,V:V").delete Shift:=xlToLeft
    .Columns("A").NumberFormat = "m/d/yyyy"
    .Columns("B").Insert Shift:=xlToRight
    .Columns("B").NumberFormat = "HH:mm:ss"
    .Columns("A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 9)), TrailingMinusNumbers:=True
End With

I've got the third array segment to not display AM/PM in a third column.

EDIT: above code includes @PeterT suggestion of formatting newly inserted column B to HH:mm:ss - Unfortunately any time between 13:00:00 and 23:59:59 are still being converted to 01:00:00 and 11:59:59 , respectively.

EDIT: I've included better examples of what I'm struggling with.

This is how the workbook starts out: enter image description here

And this is how the Text To Columns process in the VBA code changes the time format (it's showing as 01:17:52 when it should be 13:17:52): enter image description here

I've had some really useful advice from members on another unrelated code question, I'm hoping for the same again :) I have searched and found similar questions but none resulted in the answer to fix this unfortunately.

2

There are 2 best solutions below

2
On BEST ANSWER

A bit more "manual" but this worked fine for me:

Sub Tester()
    Dim ws As Worksheet, rng As Range, arr, r As Long, v
    
    Set ws = ActiveSheet
    ws.Columns("B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    ws.Range("A1").Value = "Date"
    ws.Range("B1").Value = "Time"
    
    Set rng = ws.Range("A2:B" & ws.Cells(Rows.Count, "A").End(xlUp).row)
    arr = rng.Value
    For r = 1 To UBound(arr, 1)
        v = arr(r, 1)
        If Len(v) > 0 Then
            v = v * 1                 'coerce date to number
            arr(r, 1) = Int(v)        'Date only
            arr(r, 2) = v - arr(r, 1) 'Time only
        End If
    Next r
    rng.Columns(1).NumberFormat = "mm/dd/yyyy" 'set required column formats
    rng.Columns(2).NumberFormat = "hh:mm"
    rng.Value = arr
End Sub
2
On

Now that I can see the expanded sample data, I can see that the TextToColumns method is actually splitting the timestamp into three columns (not two). So that 06/10/2023 13:17 actually becomes:

A B C
06/10/2023 1:17:00 PM

So now the trick is to combine columns B and C into a single time value and convert that.

Here is some example code to help with the conversion.

Option Explicit

Sub test()
    With ActiveSheet
        .Rows("1:5").Delete Shift:=xlUp
        .Range("F:F,N:N,O:O,P:P,S:S,U:U,V:V").Delete Shift:=xlToLeft
        .Columns("B").Insert Shift:=xlToRight
        
        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        
        Dim i As Long
        For i = 1 To lastRow
            Dim theDate As Date
            Dim theTime As Date
            Dim tokens() As String
            tokens = Split(.Cells(i, 1).Value, " ")
            theDate = DateValue(tokens(0))
            theTime = TimeValue(tokens(1) & " " & tokens(2))
                    
            '--- put the values in their place
            .Cells(i, 1).Value = theDate
            .Cells(i, 2).Value = theTime
        Next i
        .Columns("A").NumberFormat = "m/d/yyyy"
        .Columns("B").NumberFormat = "HH:mm:ss"
    End With
End Sub