CODEWITHSUNDEEP
exceldate-formattingvba
Tim
Tim

Reputation: 25

Date formatting error when importing dates stored as text

I have a simple macro (as part of a whole bunch of others in my workbook) that copies the contents of a column in one worksheet into another. This column is a bunch of dates which are stored as text. The issue is, for all dates less that the 12th of the month, it's appropriating the the day as the month and vice versa.

There is a bunch of similar topics on here and other sites but none of them have really worked. I hoping there is a simple fix.

My recent version of the macro

Sub DateMacro()

Sheets("Output").Range("A2:A1048575").NumberFormat = "d/mm/yyyy h:mm:ss AM/PM"
Sheets("Input").Range("A2:A1048575").NumberFormat = "d/mm/yyyy h:mm:ss AM/PM"
Sheets("Output").Range("A2:A1048575").Value = Sheets("Input").Range("A2:A1048575").Value

End Sub

I've linked a sample workbook here

Additional info:
I don't have control about how the dates are formatted when exported from my reporting system so I need to make the changes within my reporting workbook.

Update: I spoke to a colleague and he came up with this:

Sub test()

Dim i As Long
Dim RngEnd As Long

Dim rng As String
Dim test As String

RngEnd = Range("A1").End(xlDown).Row

For i = 2 To RngEnd

rng = "A" & i
test = Sheets("Input").Range(rng).Value

Sheets("Output").Range(rng) = DateValue(test) + TimeValue(test)


Next i
End Sub

This appears to work fine but there is a popup with "Error 13 Type Mismatch". Any idea or amendments to this one that you can think of?

Upvotes: 0

Views: 53

Answers (2)

Tim
Tim

Reputation: 25

I've found something that works in my case. Just posting in case anyone else needs it. I just need to format the Output range as Text before transferring the data and then convert it back into the date format I want.

Sheets("Output").Range("A:A").NumberFormat = "@"
Sheets("Input").Range("A:A").NumberFormat = "d/mm/yyyy h:mm:ss AM/PM"
Sheets("Output").Range("A:A").Value = Sheets("Input").Range("A:A").Value
Sheets("Output").Range("A:A").NumberFormat = "d/mm/yyyy h:mm:ss AM/PM"

Thanks to everyone else for their time/input

Upvotes: 1

Shai Rado
Shai Rado

Reputation: 33672

You can loop through each cell, check if the day is within 1 to 12, and then switch the day and month using DateSerial. Then store it in an array (to run faster), and at the end, dump the entire array to "output" sheet using Application.Transpose.

More explanation inside the code's comments.

Code

Option Explicit

Sub DateMacro()

Dim LastRow As Long, i As Long
Dim DateStr As String
Dim DatesArr() As Double

ReDim DatesArr(0)

With Sheets("Input")
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row ' get last row with data in column A

    For i = 2 To LastRow ' from 2nd row until last row with data
        ' === if day  is from 1 though 12 of the month comes "mm/dd/yyyy" >> switch month and day ===
        Select Case Day(.Range("A" & i).Value)
            Case 1 To 12
                DateStr = Format(.Range("A" & i).Value, "dd/mm/yyyy")

                ' switch month and day
                DatesArr(UBound(DatesArr)) = DateSerial(Year(DateValue(DateStr)), Day(DateValue(DateStr)), Month(DateValue(DateStr)))

            Case Else
                DatesArr(UBound(DatesArr)) = DateValue(.Range("A" & i).Value)

        End Select

        ReDim Preserve DatesArr(UBound(DatesArr) + 1) ' keep record and raise array index by 1
    Next i
End With

' resize array to actual populated size
ReDim Preserve DatesArr((UBound(DatesArr) - 1))

Sheets("Output").Range("A2:A" & LastRow).NumberFormat = "d/mm/yyyy h:mm:ss AM/PM"

' use Application.Transpose to copy the entire array contents to your range
Sheets("Output").Range("A2:A" & LastRow).Value = Application.Transpose(DatesArr)

End Sub

Upvotes: 1

Related Questions