Tuesday, July 16, 2013

Excel Macro VBA convert date

Sub ConvertDate()
'Purpose: Change a numeric data to a date format which recognizable by Excel
'It detects the no. of digits for a cell.
'10 digits: 31/12/2010 -> 31-Dec-2010
' 8 digits: 20101231   -> 31-Dec-2010
' 6 digits: 311210     -> 31-Dec-2010
' 5 digits: 61210      -> 06-Dec-2010
Dim i As Double
Dim NoOfRows As Double
Dim ColumnNo As Integer
Dim DataRange As Variant
Dim myString As String
Dim MyDateSetting As String
Dim MyMessage As String

Select Case Application.International(xlDateOrder)
Case 0
   MyDateSetting = "MDY"
Case 1
   MyDateSetting = "DMY"
Case 2
   MyDateSetting = "YMD"
End Select

If MyDateSetting <> "DMY" Then
   MyMessage = "Windows date setting: " & MyDateSetting & Chr(13) & "  Date Separator: " & Application.International(xlDateSeparator) & Chr(13)
   MyMessage = MyMessage & Chr(13) & "You may change setting to DMY before running this script: Control Panel-> Regional and language setting->customize->Date"
   MsgBox MyMessage
   Exit Sub
End If

For Each myRange In Selection
myString = myRange.Value

    If Len(myString) = 8 Then
        newDate = DateSerial(Left(myString, 4), Mid(myString, 5, 2), Right(myString, 2))
    Else
        If Len(myString) = 6 Then
            newDate = DateSerial(Right(myString, 2), Mid(myString, 3, 2), Left(myString, 2))
        Else
            If Len(myString) = 5 Then
                newDate = DateSerial(Right(myString, 2), Mid(myString, 2, 2), Left(myString, 1))
            Else
                If Len(myString) = 10 Then
                    newDate = DateSerial(Right(myString, 4), Mid(myString, 4, 2), Left(myString, 2))
                End If
            End If
        End If
    End If

    If (Trim(Len(myString)) <> 0) And (TypeName(myRange.Value) <> "Date") Then
        myRange.Value = newDate
        myRange.NumberFormat = "[$-409]dd-mmm-yy;@"
    End If
Next

End Sub

No comments:

Post a Comment