Leading zero vba excel wrong dates

Question

I have this dates from DB and I want to fix the date in VBA excel because excel switch the date with month when filter the column

27/08/2018
31/08/2018
12/9/2018
2/8/2018    wrong date reported at filter in excel need 02/08/2018
6/8/2018    wrong date reported at filter in excel need 06/08/2018
13/08/2018
17/08/2018
20/08/2018
20/08/2018

I have tried this

For i = 2 To lastRow
    Dim fDate As Date
    Dim dayF As String
    Dim monthF As String
    Dim yearF As String


    Set r = Cells(i, Column_DateStamp)
    strDate = Split(r.Text, "/")

    dayF = CStr(Format(strDate(0), "00"))
    monthF = CStr(Format(strDate(1), "00"))
    yearF = CStr(Format(strDate(2), "0000"))
    fDate = Format(DateSerial(strDate(2), CStr(Format(strDate(1), "00")), CStr(Format(strDate(0), "00"))), "dd/mm/yyyy")
    r.Clear
    r.Value = fDate
Next i

Answer 1

The date formats do not match your local date format and as such Excel is trying to convert.

You need to either put the date in and format it appropriately or make the cell text so excel does not try to convert.

Dim i As Long
For i = 2 To lastRow
    Dim fDate As Date

    Dim r As Range

    Set r = Cells(i, Column_DateStamp)
    strDate = Split(r.Text, "/")

    fDate = DateSerial(strDate(2), strDate(1), strDate(0))

    r.Clear
    'True date - comment out if you want string
    r.NumberFormat = "dd/mm/yyyy"
    r.Value2 = fDate
    'String - Uncomment if you want string
'    r.NumberFormat = "@"
'    r.Value2 = Format(fDate, "dd/mm/yyyy")

Next i

Answer 2

Examining your screenshot, the problem is consistent with your Windows Regional Settings being MDY and the Database settings being DMY . This will always result in incorrect action by Excel.

Whoever wrote the ERP application should be able to make the change to input, to Excel, an unambiguous date format; or trigger the excel text import wizard at the time of import.

You can try this macro in the meantime. It should work, but read the notes carefully for possible pitfalls:

Option Explicit
Sub ConvertDates()
    'converts dates that have been mismatched MDY / DMY
    'Assumes dates are all in selected column
    '   Only need to select a single cell in the column
    '   will place results in a column next to original data
    ' If adjacent column is not blank, a column will be inserted
    'Figures out the original format by analyzing a "text" date
    'Time components are converted directly.  This might be OK unless
    ' in a non standard format such as 1400Z

Dim R As Range, C As Range
Dim sDelim As String
Dim FileDateFormat As String * 3
Dim i As Long, j As Long, V As Variant
Dim vDateParts As Variant
Dim YR As Long, MN As Long, DY As Long
Dim TM As Double
Dim vRes As Variant 'to hold the results of conversion

Set R = Selection

'Test that selected cell contains a date
If Not IsDate(R(1)) Then
    MsgBox "Select a cell containing a date"
    Exit Sub
End If

Set R = Intersect(R.EntireColumn, ActiveSheet.UsedRange)
ReDim vRes(1 To R.Rows.Count, 1 To 1)

'Find a "text date" cell to analyze
For Each C In R
    With C
    If IsDate(.Value) And Not IsNumeric(.Value2) Then
        'find delimiter
        For i = 1 To Len(.Text)
            If Not Mid(.Text, i, 1) Like "#" Then
                sDelim = Mid(.Text, i, 1)
                Exit For
            End If
        Next i

        'split off any times
        V = Split(.Text & " 00:00")
        vDateParts = Split(V(0), sDelim)

        If vDateParts(0) > 12 Then
            FileDateFormat = "DMY"
            Exit For
        ElseIf vDateParts(1) > 12 Then
            FileDateFormat = "MDY"
            Exit For
        Else
            MsgBox "cannot analyze data"
            Exit Sub
        End If
    End If
    End With
Next C

If sDelim = "" Then
   MsgBox "cannot find problem"
   Exit Sub
End If

'Check that analyzed date format different from Windows Regional Settings
Select Case Application.International(xlDateOrder)
    Case 0 'MDY
        If FileDateFormat = "MDY" Then
            MsgBox "File Date Format and Windows Regional Settings match" & vbLf _
                & "Look for problem elsewhere"
            Exit Sub
        End If
    Case 1 'DMY
        If FileDateFormat = "DMY" Then
            MsgBox "File Date Format and Windows Regional Settings match" & vbLf _
                & "Look for problem elsewhere"
            Exit Sub
        End If
End Select

'Process dates
'Could shorten this segment but probably more understandable this way
j = 0
Select Case FileDateFormat
    Case "DMY"
        For Each C In R
        With C
            If IsDate(.Value) And IsNumeric(.Value2) Then
            'Reverse the day and the month
                YR = Year(.Value2)
                MN = Day(.Value2)
                DY = Month(.Value2)
                TM = .Value2 - Int(.Value2)
            ElseIf IsDate(.Value) And Not IsNumeric(.Value2) Then
                V = Split(.Text & " 00:00") 'remove the time
                vDateParts = Split(V(0), sDelim)
                YR = vDateParts(2)
                MN = vDateParts(1)
                DY = vDateParts(0)
                TM = TimeValue(V(1))
            Else
                YR = 0
            End If

            j = j + 1
            If YR = 0 Then
                vRes(j, 1) = C.Value
            Else
                vRes(j, 1) = DateSerial(YR, MN, DY) + TM
            End If
        End With
        Next C
    Case "MDY"
        For Each C In R
        With C
            If IsDate(.Value) And IsNumeric(.Value2) Then
            'Reverse the day and the month
                YR = Year(.Value2)
                MN = Day(.Value2)
                DY = Month(.Value2)
                TM = .Value2 - Int(.Value2)
            ElseIf IsDate(.Value) And Not IsNumeric(.Value2) Then
                V = Split(.Text & " 00:00") 'remove the time
                vDateParts = Split(V(0), sDelim)
                YR = vDateParts(2)
                MN = vDateParts(0)
                DY = vDateParts(1)
                TM = TimeValue(V(1))
            Else
                YR = 0
            End If

            j = j + 1
            If YR = 0 Then
                vRes(j, 1) = C.Value
            Else
                vRes(j, 1) = DateSerial(YR, MN, DY) + TM
            End If
        End With
        Next C
End Select

With R.Offset(0, 1).EntireColumn
    Set C = .Find(what:="*", LookIn:=xlFormulas)
    If Not C Is Nothing Then .EntireColumn.Insert
End With

R.Offset(0, 1).Value = vRes

End Sub