Formatting different date formats to a standard format

The purpose of this code is to format dates for 3 different MS Excel Files. Each file begins with a different name. One is AT, the other PT, and the last MX. Depending on the first two characters in the name of the file, the date will be formatted differently.

For example:

When the date is like this for PT and AT: 20100710

We use this formula:

=RIGHT(B38;2)&"."&MID(B38;5;2)&"."&LEFT(B38;4)

The result is: 10.07.2010

When the date is like this for MX: 1/1/2010

We use this formula:

="0"&LEFT(B39;1)&"."&"0"&MID(B39;3;1)&"."&RIGHT(B39;4)

The result is: 01.01.2010

Then we use the formatting in Excel to change it to: dd.mm.year

The sheet is called "data" and it is the only active sheet in the Excel file.

The code currently does nothing, no errors, etc. It cycles through the sheets in the folder and saves them. It changes nothing concerning the dates for "AT"or "PT".

Option Explicit

Public Sub FormatDates()
Dim wbOpen As Workbook
Dim strExtension As String

Const strPath As String = "H:\"    'Change Path to the folder you have your files in

    'Comment out the 3 lines below to debug
'    Application.ScreenUpdating = False
'    Application.Calculation = xlCalculationManual
'    On Error Resume Next

    ChDir strPath
    strExtension = Dir(strPath & "*.xls")      'change to xls if using pre 2007 excel

        Do While strExtension <> ""
            Set wbOpen = Workbooks.Open(strPath & strExtension)

            With wbOpen
               If Left(LCase(.Name), 2) = "pt" Or Left(LCase(.Name), 2) = "at" Then     'change to lower case and check start of name
                    ChangeAllDates ("NOT MX")
                    .Close SaveChanges:=True
               ElseIf Left(LCase(.Name), 2) = "mx" Then
                    ChangeAllDates ("MX")
                    .Close SaveChanges:=True
               Else
                   .Close SaveChanges:=Fals开发者_运维技巧e
               End If
            End With

            strExtension = Dir
        Loop

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    On Error GoTo 0

End Sub

Private Function ChangeAllDates(strType As String)
Dim strTemp As String
Dim strCellValue As String
Dim rng As Range
Dim cell As Range
Dim sht As Worksheet

    Set sht = ActiveSheet

    Sheets("data").Activate     'selects sheet named data

    Set rng = Range("C2:C" & GetLastPopulatedCell(2, 2, sht)) 'finds last populated cell

    On Error GoTo err_check

    For Each cell In rng

        strCellValue = CStr(cell.Value)

        If Len(strCellValue) > 2 Then   'only check cells that have more than 2 charactors in them

            If InStr(1, strCellValue, ".", vbTextCompare) = 0 Then
                If strType = "MX" Then
                    strTemp = Left(strCellValue, 4) & "." & Mid(strCellValue, 5, 2) & "." & Right(strCellValue, 2)
                Else
                    strTemp = Right(strCellValue, 2) & "." & Mid(strCellValue, 5, 2) & "." & Left(strCellValue, 2)
                End If

                If InStr(1, strCellValue, "/", vbTextCompare) > 0 Then      'change data / to .
                    strTemp = Replace(strCellValue, "/", ".", 1, , vbTextCompare)

                    'now check to make sure that it reads yyyy.mm.dd if not then we need to reverse it and check
                    'it has 2 numbers for month and year

                    strTemp = CheckDataFormat(strTemp)


                End If
            Else
                strTemp = strCellValue
            End If

            cell.Value = strTemp        'replace the cell value with the formatted value

            strCellValue = ""
            strTemp = ""

            End If

    Next cell

    On Error GoTo 0

    Exit Function

err_check:

    MsgBox Error.Name & vbCrLf & "Error happend on cell " & cell.Address

End Function

Private Function GetLastPopulatedCell(lgRow As Long, lgCol As Long, sht As Worksheet) As Long
Dim i As Integer
Dim s As String

    For i = 0 To 10000        'set a default number of cells to check in this case I have set it to 10,000
        If sht.Cells(lgRow, lgCol).Value <> "" Then
            lgRow = lgRow + 1
        Else
            GetLastPopulatedCell = lgRow - 1
            Exit For
        End If
    Next i

End Function

Private Function CheckDataFormat(str As String) As String

Dim strR As String
Dim i As Integer
Dim vArray As Variant

'str = "06.01.2011"

    'have to check if date is in d.m.yyyy format if so we need to change it to dd.mm.yyyy

    If Len(str) < 10 Then           'only care if less than 10 charators

        vArray = Split(str, ".")    'split into array on points
        str = ""

        For i = 0 To UBound(vArray)

            If Len(vArray(i)) = 1 Then                  'if only 1 charactor long we know we are missing 0
                str = str & "0" & vArray(i) & "."       'check if 0 exists before number if not add it
            Else
                str = str & vArray(i) & "."
            End If
        Next i

        'remove last dot on the end
        If Right(str, 1) = "." Then str = Left(str, Len(str) - 1)
    End If

    Debug.Print str

    'strR = Right(str, 5)

    'If Left(strR, 1) = "." Then
     '   str = Right(str, 4) & "." & Left(str, (Len(str) - 5))       'move the year to the front
      '  str = Left(str, 5) & Right(str, 2) & Mid(str, 5, 3)         'switch round month and day
     '   Debug.Print str
    'End If

    CheckDataFormat = str

End Function

I suppose the AT, PT and MX stand for the country codes of Austria, Portugal and Mexico ....

In general my experience with international Excel applications is: do not format dates in Excel at all! This is what I do:

• Make sure entries in cells containing dates are really done/recognized as a date format (vartype(cell) = vbDate) - you can check/trap this via a Sub ...Change() trigger
• format/display the date cell in the system's short or long format (as per need/taste)

It is and should remain in the power of the user to select his/her favourite (system) date format which applications should respect. This way you are also covering the ever increasing problem of nomadic users (e.g. British working in France, French travelling to US, etc.)

• anything else increases trouble - like in your example you're converting to a string ...
• so you can forget date arithmetic unless you convert back ... another function which needs to recognize the country specific details
• tomorrow your company goes to France, Brazil and South Africa ... trouble again

Hope this helps

good luck - MikeD