Date Formatting in Excel VBA

[CASpears]

Hello: Looking for help with this code. Currently it is not working but not sure what is wrong. The purpose 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

You are not misunderstanding.

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(B3 9;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 just 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:=False
               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

[NeoPa]

CASpears:
You are not misunderstanding.

Oh, I think we probably are. Big time.

Let's start off with a few basics and see if we can make our way to some sort of clear understanding of what's going on and what's required :

1. Firstly, this is an Excel question. This is perfectly acceptable, but it would make sense to indicate so in the title as the name of the forum is Access / VBA. I will update that for you.
2. This is neither British nor American locale for dates and numbers. Please indicate what country the code is for and what the formatting required is (standard short date and number formats would be helpful to see).
3. I'm sure your explanation of the formats of the data that is to be expected in each file type has been confused in the translation, but it would help to include some examples of each type (which don't include day numbers below 13) so we can determine what data to expect coming in.
4. In your example data, please include what you are hoping to convert the data to. This will help us to understand better what you are after.

If you can provide all this information then I expect we can help you. If there is any you're confused about, please ask. Without the requested information the question is likely to be stalled.

[CASpears]

NeoPa:

I resolved the issue elsewhere. Thanks anyway...