US date format on VBA import

Viewed 36

Bloody annoying US dates again, this one I've not seen a solution on my many, many searches.

I have a bit of VBA I found that pulls in data from some htm files generated by our business partner in Detroit:

Dim DirPath As String
Dim I_Row As Integer
Dim FilePath As String
Dim xCount As Long
DirPath = ipsosFolder
If DirPath = "" Then Exit Sub
Application.ScreenUpdating = False
FilePath = Dir(DirPath & "\*.htm")
Do While FilePath <> ""
    With ActiveSheet.QueryTables.Add(Connection:="URL;" _
      & DirPath & "\" & FilePath, Destination:=Range("A1"))
    .Name = "a"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlAllTables
    .WebFormatting = xlWebFormattingNone
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = True
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
    FilePath = Dir
    End With
Loop

(Note the .WebDisableDateRecognition = True, that was my first hope at fixing this, have Excel ignore the americanised dates until I could do something to fix them.)

So there's dates in here formatted in the US way - 09/21/2022 for today, for example. Now, this particular date is of no concern as here in Australia, it's invalid, there is no 21st month and I can easily fix this up with a quick =RIGHT(LEFT(B2,5),2)&"/"&LEFT(B2,2)&"/"&RIGHT(B2,10) but my problem comes in when we get to dates like 09/12/2022 as there is a 9th of December as well as 12th of September and Excel, very kindly, converts this to a date integer which breaks the above code as the left / right is no longer referencing 09/12/2022 but 44904.

Anyone with a suggestion on what I can do stop Excel "helping" and converting the dates to an American interpretation - I've been over the machine and double checked all the windows settings are for the correct date format here.

The big issue is I need to compare these dates against some dates we have pulled in from another dataset that're in the "proper" format of d/m/y and not m/d/y like only the Americans seem to insist on using, so need to retain them as dates and accurate = \

1 Answers

If (US) Date having month less or equal to 12 are converted swapping day with month and the other ones remain strings/text, please use the next function:

Function convertUSStr_DateToAU(arr As Variant) As Variant
    Dim arrConv, arrStrD, i As Long
    ReDim arrConv(1 To UBound(arr), 1 To 1)
    For i = 1 To UBound(arrConv)
        If IsNumeric(arr(i, 1)) Then
            arrConv(i, 1) = DateSerial(Year(arr(i, 1)), Day(arr(i, 1)), Month(arr(i, 1)))
        Else
            arrStrD = Split(arr(i, 1), "/")
            arrConv(i, 1) = DateSerial(CLng(arrStrD(2)), CLng(arrStrD(0)), CLng(arrStrD(1)))
        End If
    Next i
    convertUSStr_DateToAU = arrConv
End Function

It can be used in the next way:

Sub testConvertUSStr_DateToAU()
     Dim sh As Worksheet, lastR As Long, arrD
     Const Col As String = "B" 'column letter where the data to be correctly converted exists
     
     Set sh = ActiveSheet
     lastR = sh.Range(Col & sh.rows.count).End(xlUp).row
     
     arrD = sh.Range(Col & 2 & ":" & Col & lastR).Value2 'Date is taken as number...
     arrD = convertUSStr_DateToAU(arrD)
     'drop the converted array content and format it appropriately:
     With sh.cells(2, Col).Offset(, 1).Resize(UBound(arrD), 1)
            .Value2 = arrD
            .NumberFormat = "dd/mm/yyy"
     End With
End Sub

You must have an empty column immediately after the one to be converted/processed. The actual code returns the converted array in that empty column. But, only to let you check that it returned exactly what you need...

If so, you should modify the With statement range by only removing .Offset(, 1). In this way it will return exactly in the original column needing to have the converted Date.

Related