dates sorting

ziond 

Since sorting a column of date entries, especially very recent along with very old dates like 17th or 18th centuries produce unpredictable results, I have decided to study the problem. It turns out that I could only resolve this problem by writing a VBA excel program. This program provides instructions and generates a column based on the following rules and assumptions:

1. It was written for the 365 Office platform and the American form of M/D/Y for dates.
2. It assumes that the divider is “/” and includes a 4-digit year, such as 02/06/1854 or 6/5/2001.
3. It may or may not include a time entry such as 6/5/2001 8:55:12 PM.
4. It provides a column transformed to the form Y/M/D, that lends itself to a predictable sort.
5. Generally, this generated column is found to be useful as a hidden column.
6. When a sort of the visible column is requested, it is the hidden column that effects the sorting.

The program is as follows: (Reply for any questions you may have.)

Sub DateAdjust()
Dim A, B, C, D, E, F, G, H, I, J, K, Sel1, FromTo
FromTo = Selection.Rows.Address(0, 0)
If InStr(FromTo, ",") = 0 Then
A = MsgBox("SELECT CELL IN FIRST ROW OF COLUMN OF DATES TO BE SORTED" & vbCr & vbLf & " AND," & vbCr & vbLf & "WHILE HOLDING CTRL BUTTON," & vbCr & vbLf & _
vbCr & vbLf & "SELECT SECOND CELL IN ANY OR THE SAME ROW OF AN EMPTY COLUMN.", vbYesNo + vbDefaultButton1, "SORT ALL DATES (OLD & NEW)")
If A = vbNo Then Exit Sub
Else
B = Left(FromTo, InStr(FromTo, ",") - 1)
C = Right(FromTo, InStr(FromTo, ",") - 1)
Range(B).Select
F = ActiveCell.Column
F = Split(Cells(1, F).Address, "$")(1)
G = ActiveCell.Row
Range(Selection, Selection.End(xlDown)).Select
Sel1 = Selection.Rows.Address(0, 0)
D = Selection.Rows.Count
Range(C).Select
E = Selection.Address(0, 0)
H = ActiveCell.Column
H = Split(Cells(1, H).Address, "$")(1)
I = ActiveCell.Row
Range(E & ":" & H & I + D).Select
Selection.NumberFormat = "@"
ActiveCell.Select
For J = 1 To D
Range(F & G + (J - 1)).Select
Call Adjust(H & I + (J - 1))
Next J
Range(E & ":" & H & I + D).Select
Selection.HorizontalAlignment = xlCenter
ActiveCell.Select
End If
End Sub
Sub Adjust(X)
Dim A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q
F = ActiveCell
If Len(F) > 10 Then
F = Date
End If
E = StrReverse(F)
J = InStr(1, E, "/")
K = Right(F, J - 1)
L = year(F)
If J = 3 Then G = L & "/" Else G = Right(F, 4) & "/"
A = InStr(F, "/")
If A < 3 Then B = "0" & Left(F, A - 1) & "/" Else B = Left(F, A - 1) & "/"
C = InStr(A + 1, F, "/")
If C < 5 Then D = "0" & Mid(F, C - 1, 1) Else D = Mid(F, C - 2, 2)
H = Left(F, C)
I = G & B & D
Range(X).Select
ActiveCell = I
End Sub