Separating whole date and time in VBA

Question

I only can separate date and time to one column.

How can i separate date and time to all columns?

Dim DateTime As Date
DateTime = Range("D2").Value

'get date
Range("E2").Value = Int(DateTime)
Range("E2").NumberFormat = "DD/MM/YYYY"

'get time
Range("F2").Value = DateTime - Int(DateTime)
Range("F2").NumberFormat = "hh:mm"

[

Answer 1

Split Date & Time

Before

After

• Adjust (play with) the values in the constants section.

The Code

Option Explicit

Sub SplitDateTime()
    
    ' Source (Date & Time)
    Const sName As String = "Sheet1"
    Const sFirst As String = "D2"
    ' Date
    Const dName As String = "Sheet1"
    Const dFirst As String = "E2"
    Const dFormat As String = "dd\/mm\/yyyy"
    ' Time
    Const tName As String = "Sheet1"
    Const tFirst As String = "F2"
    Const tFormat As String = "hh:mm:ss"
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim srg As Range
    Dim wsrCount As Long
    Dim rCount As Long
    
    ' Source Range (Date & Time)
    With wb.Worksheets(sName).Range(sFirst)
        wsrCount = .Worksheet.Rows.Count
        Dim slCell As Range
        Set slCell = .Resize(wsrCount - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If slCell Is Nothing Then
            MsgBox "Empty column.", vbCritical, "Split Date & Time"
            Exit Sub
        End If
        rCount = slCell.Row - .Row + 1
        Set srg = .Resize(rCount)
    End With
    
    ' Source Array (Date & Time)
    Dim sData As Variant
    If rCount = 1 Then ' one cell (row) only
        ReDim sData(1 To 1, 1 To 1): sData(1, 1) = srg.Value
    Else ' multiple cells (rows)
        sData = srg.Value
    End If
    
    Dim dData() As Variant: ReDim dData(1 To rCount, 1 To 1) ' Date
    Dim tData() As Variant: ReDim tData(1 To rCount, 1 To 1) ' Time
    
    Dim cValue As Variant
    Dim r As Long
    
    ' Split
    For r = 1 To rCount
        cValue = sData(r, 1)
        If VarType(cValue) = vbDate Then
            dData(r, 1) = Int(cValue) ' Date
            tData(r, 1) = cValue - Int(cValue) ' Time
        End If
    Next r
    
    Application.ScreenUpdating = False
    
    ' Date
    With wb.Worksheets(dName).Range(dFirst)
        .Resize(rCount).NumberFormat = dFormat
        .Resize(rCount).Value = dData
        .Resize(wsrCount - .Row - rCount + 1) _
            .Offset(rCount).Clear
        .Worksheet.Columns(.Column).AutoFit
    End With
        
    ' Time
    With wb.Worksheets(tName).Range(tFirst)
        .Resize(rCount).NumberFormat = tFormat
        .Resize(rCount).Value = tData
        .Resize(wsrCount - .Row - rCount + 1) _
            .Offset(rCount).Clear
        .Worksheet.Columns(.Column).AutoFit
    End With
        
    Application.ScreenUpdating = True
    
    MsgBox "Date & time split successfully.", vbInformation, "Split Date & Time"

End Sub

Answer 2

There is a simple way to do this. Here is an example

Let's say our worksheet looks like this

Code

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long
    
    '~~> Change this to relevant sheet
    Set ws = Sheet1
    
    With ws
        '~~. Find last row in column D
        lRow = .Range("D" & .Rows.Count).End(xlUp).Row
        
        '~~> Insert formula in column E to get the date part
        .Range("E2:E" & lRow).Formula = "=DATE(YEAR(D2),MONTH(D2),DAY(D2))"
        '~~> Insert formula in column F to get the time part
        .Range("F2:F" & lRow).Formula = "=TIME(HOUR(D2),MINUTE(D2),SECOND(D2))"
        
        '~~> Convert formulas to values
        .Range("E1:F" & lRow).Value = .Range("E1:F" & lRow).Value
    End With
End Sub

Output

Note: In the above code, feel free to use .NumberFormat to format the range in one go. For example .Range("E1:E" & lRow).NumberFormat = "DD/MM/YYYY"