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