Converting Column To Specific Date Format

[HTSCF Fareha]

I'm hoping that somebody can please help me to fathom this one out.

I have a column of data that has been captured from a bespoke database programme which on the face of it, looks to be in dd/mm/yyyy time format. Having tried to manually select the column and then convert it to the required dd/mm/yyyy format (basically removing the time element), I soon realised that something was not quite right as after applying the required date format, it seemed on the face of it to do absolutely nothing.

Having then Googled the issue, I believe that the column has been exported and saved in text format and hence why it would not convert to the required date format.

Ultimately I am trying to get this to function as a macro which will be part of a larger project. Using the macro recorder, I arrived at the following code which although a bit rough and ready, was hoping would provide me with a column 'D' in the required dd/mm/yyyy format, but it only appears to be working on some of the cells and not others.

 Columns("D:D").Select
    Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Selection.NumberFormat = "dd/mm/yyyy"

I'd really appreciate help in getting a bit of macro code to achieve my goal.

Thanks!

[June7]

Why is there no code in this workbook?

Since I am in the U.S., can be difficult for me to test code with international date.

Problem appears to be d/m/y structure of string dates. Conversion fails on those dates where day is greater than 12. Likely because VBA expects U.S. date structure of m/d/y.

Possibly will have to parse date string to discrete date parts, recombine as U.S. structure, convert with DateValue(), save to cells and set formatting. Try setting Date format with U.K. location instead of Custom format.

Expression in cell:
=DATEVALUE(MID(D2,4,2) & "/" & LEFT(D2,2) & "/" & MID(D2,7,4))
With Date format using U.K. location, d/m/yyyy structure is available option and dates display correctly for me.

[snb]

Please read how you can define fields in the 'Texttocolumns' method.
Even the textcolumns wizard shows the options.

[p45cal]

    Columns("D:D").Select
    Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 4), Array(2, 9)), TrailingMinusNumbers:=True

It loses the time element.

To include time:

With Range(Range("D2"), Cells(Rows.Count, "D").End(xlUp))
  .TextToColumns Destination:=Range("D2"), DataType:=xlDelimited, _
                 TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
                 Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
                 :=Array(Array(1, 4), Array(2, 1)), TrailingMinusNumbers:=True
  .NumberFormat = "mm/dd/yyyy hh:mm"
  For Each cll In .Cells
    cll.Value = cll.Value + cll.Offset(, 1).Value
  Next cll
  .Offset(, 1).Clear
End With

[arnelgp]

another option, run subFmtDDMMYYYY sub.

[June7]

Nice, p45cal. Works.

However, don't need to actually Select anything.

Good practice to qualify references.

With Worksheets("Involved")
    .Columns("D:D").TextToColumns Destination:=.Range("D1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 4), Array(2, 9)), TrailingMinusNumbers:=True
    .Columns("D:D").NumberFormat = "dd/mm/yyyy"
End With

[HTSCF Fareha]

My thanks to all who contributed to helping me on this one.

Each of the options provided by p45cal (post #4), arnelgp (post #5) and June7 (post #6) work!

[snb]

@ June

I agree, but advise to be consistent:

With sheets("Involved").Columns(4)
   .TextToColumns .cells(1), ,, , ,, , , ,array(Array(1, 4), Array(2, 9))
   .NumberFormat = "dd/mm/yyyy"
End With

Alternative:

Sub M_snb()
  columns(4).replace "/", "-"
End sub

[HTSCF Fareha]

another option, run subFmtDDMMYYYY sub.

Just noticed that this swaps the day and month about.

[arnelgp]

change the sub to this:

Public Sub subFmtDDMMYYYY()
    Dim rw As Long, last_rw As Long
    Dim vlue As Variant
    last_rw = Cells(Cells.Rows.Count, 4).End(xlUp).Row
    For rw = 2 To last_rw
        vlue = Cells(rw, 4)
        Cells(rw, 4) = CDate(Month(vlue) & "/" & Day(vlue) & "/" & Year(vlue)) + TimeValue(vlue)
        Cells(rw, 4).NumberFormat = "dd/mm/yyyy"
    Next
End Sub

[HTSCF Fareha]

Sorry arnelgp, it is still not working. It seems to swap dd and mm for anything under the value of 12.

[arnelgp]

it seems that most of the cells are "not valid" date (examle using =Month("D4") will result in #VALUE! result.
i change the sub to handle invalidate dates.

Public Sub subFmtDDMMYYYY()
    Dim rw As Long, last_rw As Long
    Dim vlue As Variant
    Dim txt As String
    Dim dte As Variant, tim As String
    last_rw = Cells(Cells.Rows.Count, 4).End(xlUp).Row
    For rw = 2 To last_rw
        vlue = Cells(rw, 4)
        txt = WorksheetFunction.Text(Cells(2, 4), "m")
        If IsNumeric(txt) Then
            'if numeric, it is a valid date
            Cells(rw, 4) = CDate(Month(vlue) & "/" & Day(vlue) & "/" & Year(vlue)) + TimeValue(vlue)
        Else
            'not valid date
            dte = Split(vlue, "/")
            tim = Split(dte(2))(1)
            dte(2) = Replace$(dte(2), tim, "")
            Cells(rw, 4) = CDate(dte(1) & "/" & dte(0) & "/" & dte(2)) + TimeValue(tim)
        End If
        Cells(rw, 4).NumberFormat = "dd/mm/yyyy"
    Next
End Sub

[georgiboy]

Here is another option using an array and the function 'CDate', it will keep the time and date.

Sub test()
    Dim rng As Range, var As Variant, x As Long
    
    With Worksheets("Involved")
        Set rng = .Range(.Cells(2, "D"), .Cells(Rows.Count, "D").End(xlUp))
    End With
    
    var = rng.Value

    For x = 1 To UBound(var)
        var(x, 1) = CDate(var(x, 1))
    Next x

    rng = var
End Sub

[HTSCF Fareha]

Wow, I hadn't realised that some of the dates were not even proper ones! I'm not sure how / why the programme that produces the original output would generate anything like this as it seems illogical.

Anyhow, my thanks arnelgp as this now formats the dates as required and removes the time element as this is not required. However, I have only more thing to ask if I may. Can this code be modified so that it will work on multiple worksheets contained within a single workbook?

At the moment it appears to work on the currently selected worksheet if this is the last one, but ignores any worksheets before it leaving the data untouched. If say the first worksheet is selected, then the sub run, it works on that worksheet okay, but throws a runtime error 13 type mismatch on

Cells(rw, 4) = CDate(Month(vlue) & "/" & Day(vlue) & "/" & Year(vlue)) + TimeValue(vlue)

on the next.

Here is my sub along with your code incorporated within it that I hope can be modified to work as required.

Private Sub RMS_History(ws)

    Dim x      As Variant
    Dim rw     As Long, last_rw As Long
    Dim vlue   As Variant
    Dim txt    As String
    Dim dte    As Variant, tim As String

    Application.ScreenUpdating = False
    
    ' -------------------------------------------------------
    ' Set font for each worksheet
    
    With ws
        .Cells.Font.Name = "Calibri"
        .Cells.Font.Size = 11
        .Cells.VerticalAlignment = xlVAlignCenter
        .Cells.HorizontalAlignment = xlHAlignLeft
        
        ' -------------------------------------------------------
        ' Perform the basic editing
        
        ' Tidy date column by converting from text to required date format
        
        last_rw = Cells(Cells.Rows.Count, 4).End(xlUp).Row
        For rw = 2 To last_rw
            vlue = Cells(rw, 4)
            txt = WorksheetFunction.Text(Cells(2, 4), "m")
            If IsNumeric(txt) Then
                'if numeric, it is a valid date
                Cells(rw, 4) = CDate(Month(vlue) & "/" & Day(vlue) & "/" & Year(vlue)) + TimeValue(vlue)
            Else
                'not valid date
                dte = Split(vlue, "/")
                tim = Split(dte(2))(1)
                dte(2) = Replace$(dte(2), tim, "")
                Cells(rw, 4) = CDate(dte(1) & "/" & dte(0) & "/" & dte(2)) + TimeValue(tim)
            End If
            Cells(rw, 4).NumberFormat = "dd/mm/yyyy"
        Next
        
        
        .Columns("E:E").Delete                    ' Delete column E as this is not required
        
        ' Delete all rows with a date older than eighteen months

        .AutoFilterMode = False
        Dim FilterRange As Range, myDate As Date
        myDate = DateSerial(Year(Date) - 1, Month(Date) - 6, Day(Date))
        Set FilterRange = .Range("D2:D" & .Cells(.Rows.Count, 1).End(xlUp).Row)
        FilterRange.AutoFilter Field:=1, Criteria1:="<" & CDbl(myDate)
        On Error Resume Next
        With FilterRange
            .Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).EntireRow.Delete
        End With
        Err.Clear
        Set FilterRange = Nothing
        .AutoFilterMode = False
        
    End With
    
    Application.ScreenUpdating = True
    
End Sub

[georgiboy]

Didn't realise you wanted to drop the time part, just in case you are interested, below is the updated version of the code above but for date only. It works fine for me using UK date regional settings.

Sub test()
    Dim rng As Range, var As Variant, x As Long
    
    With Worksheets("Involved")
        Set rng = .Range(.Cells(2, "D"), .Cells(Rows.Count, "D").End(xlUp))
    End With
    
    var = rng.Value

    For x = 1 To UBound(var)
        var(x, 1) = Int(CDate(var(x, 1)))
    Next x

    rng = var
End Sub

[HTSCF Fareha]

Many thanks georgiboy, the code you have provided in the previous post does indeed work and, by removing the 'with' elements will work on multiple worksheets in the same workbook.

I am still trying to understand VBA and looking to learn as I go. I think I appreciate how your code is working, but not how the rng = var final line?

[arnelgp]

you can use Array() of worksheet names and Array() of columns to process multiple sheets:

Private Sub RMS_UpdateDateColumn()

    Dim arrWsh As Variant
    Dim arrCol As Variant
    Dim i As Integer
    
    ' the worksheets to work with, Change the name if necessary
    arrWsh = Array("Involved", "Sheet2")
    
    ' the column number where the date is located, change the column Number if necessary
    arrCol = Array(4, 4)
    
    For i = 0 To UBound(arrWsh)
        Call RMS_History(Worksheets(arrWsh(i)), arrCol(i))
    Next
    
End Sub

Private Sub RMS_History(ByRef ws As Worksheet, ByVal nCol As Long)

    Dim x      As Variant
    Dim rw     As Long, last_rw As Long
    Dim vlue   As Variant
    Dim txt    As String
    Dim dte    As Variant, tim As String

    Application.ScreenUpdating = False
    
    ' -------------------------------------------------------
    ' Set font for each worksheet
    
    With ws
        .Cells.Font.Name = "Calibri"
        .Cells.Font.Size = 11
        .Cells.VerticalAlignment = xlVAlignCenter
        .Cells.HorizontalAlignment = xlHAlignLeft
        
        ' -------------------------------------------------------
        ' Perform the basic editing
        
        ' Tidy date column by converting from text to required date format
        
        last_rw = .Cells(.Cells.Rows.Count, nCol).End(xlUp).Row
        For rw = 2 To last_rw
            vlue = .Cells(rw, nCol)
            txt = WorksheetFunction.Text(.Cells(rw, nCol), "m")
            If IsNumeric(txt) Then
                'if numeric, it is a valid date
                .Cells(rw, nCol) = CDate(Month(vlue) & "/" & Day(vlue) & "/" & Year(vlue)) + TimeValue(vlue)
            Else
                'not valid date
                dte = Split(vlue, "/")
                tim = Split(dte(2))(1)
                dte(2) = Replace$(dte(2), tim, "")
                .Cells(rw, nCol) = CDate(dte(1) & "/" & dte(0) & "/" & dte(2)) + TimeValue(tim)
            End If
            .Cells(rw, nCol).NumberFormat = "dd/mm/yyyy"
        Next
        
        
        .Columns("E:E").Delete                    ' Delete column E as this is not required
        
        ' Delete all rows with a date older than eighteen months

        .AutoFilterMode = False
        Dim FilterRange As Range, myDate As Date, myCol As String
        
        myCol = ColumnLetter(nCol)
        myDate = DateSerial(Year(Date) - 1, Month(Date) - 6, Day(Date))
        
        Set FilterRange = .Range(myCol & "2:" & myCol & .Cells(.Rows.Count, 1).End(xlUp).Row)
        FilterRange.AutoFilter Field:=1, Criteria1:="<" & CDbl(myDate)
        On Error Resume Next
        With FilterRange
            .Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).EntireRow.Delete
        End With
        Err.Clear
        Set FilterRange = Nothing
        .AutoFilterMode = False
        
    End With
    
    Application.ScreenUpdating = True
    
End Sub

' chatgpt
Function ColumnLetter(ByVal ColNum As Integer) As String
    Dim vArr As Variant
    vArr = Split(Cells(1, ColNum).Address(True, False), "$")
    ColumnLetter = vArr(0)
End Function

[georgiboy]

I think I appreciate how your code is working, but not how the rng = var final line?

Just to explain:

The below part sets the range to work on:

With Worksheets("Involved")
     Set rng = .Range(.Cells(2, "D"), .Cells(Rows.Count, "D").End(xlUp))
End With

This part writes the values in that range to an array named 'var':

var = rng.Value

This part loops through that array and converts the text to a UK date format (within the array only):

For x = 1 To UBound(var)
    var(x, 1) = Int(CDate(var(x, 1)))
Next x

As the conversion was made only within the array (in memory) the values need to be written back to the worksheet, the below line does this:

rng = var

To work with a range of spreadsheets, you can use:

Sub test1()
    Dim rng As Range, var As Variant, x As Long, ws As Worksheet
    
    For Each ws In Sheets(Array("Sheet1", "Sheet2", "Sheet3"))
        With ws
            Set rng = .Range(.Cells(2, "D"), .Cells(Rows.Count, "D").End(xlUp))
        End With
        
        var = rng.Value
        
        For x = 1 To UBound(var)
            var(x, 1) = Int(CDate(var(x, 1)))
        Next x
        
        rng = var
    Next ws
End Sub

To work with all worksheets in a workbook, you can use:

Sub test2()
    Dim rng As Range, var As Variant, x As Long, ws As Worksheet
    
    For Each ws In Sheets
        With ws
            Set rng = .Range(.Cells(2, "D"), .Cells(Rows.Count, "D").End(xlUp))
        End With
        
        var = rng.Value
        
        For x = 1 To UBound(var)
            var(x, 1) = Int(CDate(var(x, 1)))
        Next x
        
        rng = var
    Next ws
End Sub

[HTSCF Fareha]

My thanks to arnelgp for their solution and for georgiboy for theirs along with the explanation of coding. This is very helpful.

Two different approaches to the same problem, that both provide the solution.