Sort data by categories between certain dates.

I have a much improved and more flexible VBA routine to replace the one I sent you yesterday:

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 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

calof1 

calof1 

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:

Sub DateAdjust()

   Dim A, B, C, D, E, F, G, H, I, J, 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 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

      Range(Selection, Selection.End(xlDown)).Select

      Sel1 = Selection.Rows.Address(0, 0)

      D = Selection.Rows.Count

      Selection.Copy

      Range(C).Select

      Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

      Application.CutCopyMode = False

      ActiveCell.Offset(0, 1).Select

      E = Selection.Address(0, 0)

      Range(E & ":" & Left(E, 1) & D + 1).Select

      Selection.NumberFormat = "@"

      For J = 1 To D

         Call Adjust

      Next J

      Range(C & ":" & Left(C, 1) & D + 1).Select

      Selection.ClearContents

      Range(E).Select

   End If

End Sub

Sub Adjust()

   Dim A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q

   F = ActiveCell.Offset(0, -1)

   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

   ActiveCell = I

   ActiveCell.Offset(1, 0).Range("A1").Activate

End Sub

calof1 

Although finding a solution to an Excel problem is the main goal of being here, however, Being new to this community, I am much enjoying the discussions back and forth....  so on a second thought, I agree with Wyn Hopkins  and PeterBartholomew1  that for the issues of 

Availability of the Tool

Stability & Testing

Manual Refreshing

Then, Power Query would be a better option.

Thank you

Nabil Mourad

calof1 

As Wyn Hopkins  said, Power Query is a great option and can be easily refreshed to include new data.

If you have Office 365 then my preference will be to Dynamic Arrays SortBy function.

Good Luck

Nabil Mourad