0
votes

I know its basic, but I am new to excel vba and learning, how can I sort a string with csv dates to order ascending from current for example

result = "31-Dec-2020,24-Sep-2020,25-Mar-2021,02-Jul-2020,09-Jul-2020,16-Jul-2020,30-Jul-2020,23-Jul-2020,27-Aug-2020,06-Aug-2020,13-Aug-2020,20-Aug-2020,30-Dec-2021,29-Dec-2022,29-Jun-2023,24-Jun-2021,30-Jun-2022"

3
Every Thursday ? NSE :)Naresh

3 Answers

2
votes

If the string is in "A2" then enter in "B2" following formula. Or you can use it in other desired procedure.

=SortArr(A2,",",0)

Following is the VBA function for "Dates" .. Reference this link for numbers and text ..

Option Explicit

Function SortArr(myString As String, deLmt As String, Optional srtCriteria = 0)
'myString is deLmt seperated Dates string
'srtCriteria is criteria to sort; 0 or nothing for Ascending, Other digit for descending.
Dim Lb As Long, Ub As Long, i As Long, j As Long
Dim arr, reverseArray
Dim strTemp As String

arr = Split(Trim(myString), deLmt)
Lb = LBound(arr)
Ub = UBound(arr)
For i = Lb To Ub - 1
    For j = i + 1 To Ub
        If DateValue(arr(i)) > DateValue(arr(j)) Then
        strTemp = arr(i)
        arr(i) = arr(j)
        arr(j) = strTemp
        End If
    Next j
Next i

If srtCriteria = 0 Then
    SortArr = Join(arr, deLmt)
    Else
    ReDim reverseArray(Ub)
        For i = 0 To Ub
            reverseArray(i) = arr(Ub - i)
        Next
    SortArr = Join(reverseArray, deLmt)
End If

End Function

enter image description here

2
votes

If one has Excel O365, you don't need to use an UDF. A possible solution (with your text in A1):

=TEXTJOIN(",",1,PROPER(TEXT(SORTEREN(FILTERXML("<t><s>"&SUBSTITUTE(A6,",","</s><s>")&"</s></t>","//s"),,1),"dd-mmm-yyyy")))
2
votes

Array of Dates in a String

  • You only run the first Sub, the following 3 procedures are being called.
  • The result is a 1D array containing the dates (as Date).
  • The last Sub demonstrates how Transpose similarly to Split converts dates to strings. The same happens with the ArrayList. Additionally it shows how to copy the arrays to columns in a worksheet.

How?

  • The getDates Sub is calling the getDatesFromString Function which splits the string by "," to the Init Array and further each of those new strings is split by "-" to the Curr Array.
  • Then the values are written to the Data Array where each second value representing the month is calculated by calling the getMonthENG3 function.
  • Finally the array is being sorted by the Sub sort1D which uses the QuickSort algorithm and being passed to the variable Data in the initial Sub (getDates).

The Code

Option Explicit

Sub getDates()
    Dim Result As String
    Result = "31-Dec-2020,24-Sep-2020,25-Mar-2021,02-Jul-2020,09-Jul-2020," _
           & "16-Jul-2020,30-Jul-2020,23-Jul-2020,27-Aug-2020,06-Aug-2020," _
           & "13-Aug-2020,20-Aug-2020,30-Dec-2021,29-Dec-2022,29-Jun-2023," _
           & "24-Jun-2021,30-Jun-2022"
    Dim Data() As Date: Data = getDatesFromString(Result)
    ' The result is a 1D array with the dates sorted ascending.
End Sub

Function getDatesFromString(ByVal InitString As String, _
                            Optional ByVal StringSeparator As String = ",", _
                            Optional ByVal DateSeparator As String = "-") _
         As Variant
    Dim Init() As String: Init = Split(InitString, StringSeparator)
    Dim Curr() As String, i As Long, Data() As Date: ReDim Data(UBound(Init))
    For i = 0 To UBound(Init)
        Curr = Split(Init(i), DateSeparator)
        Data(i) = DateSerial(CLng(Curr(2)), getMonthENG3(Curr(1)), CLng(Curr(0)))
    Next i
    sort1D Data, 0, UBound(Data)
    getDatesFromString = Data
End Function

Function getMonthENG3(ByVal Month3 As String) As Long
    Dim months As Variant
    months = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "" _
                 & "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
    getMonthENG3 = Application.Match(Month3, months, 0)
End Function

Sub sort1D(Data As Variant, _
           Optional ByVal Lb As Long, _
           Optional ByVal Ub As Long)
    Dim Tmp As Variant, LO As Long, HI As Long, Piv As Long
    LO = Lb: HI = Ub: Piv = Data((Lb + Ub) \ 2)
    Do
        Do While (Data(LO) < Piv): LO = LO + 1: Loop
        Do While (Data(HI) > Piv): HI = HI - 1: Loop
        If (LO <= HI) Then
            Tmp = Data(LO)
            Data(LO) = Data(HI): Data(HI) = Tmp: LO = LO + 1: HI = HI - 1
        End If
    Loop While (LO <= HI)
    If (Lb < HI) Then sort1D Data, Lb, HI
    If (LO < Ub) Then sort1D Data, LO, Ub
End Sub

Sub writeDatesInvestigate()
    Dim Result As String
    Result = "31-Dec-2020,24-Sep-2020,25-Mar-2021,02-Jul-2020,09-Jul-2020," _
           & "16-Jul-2020,30-Jul-2020,23-Jul-2020,27-Aug-2020,06-Aug-2020," _
           & "13-Aug-2020,20-Aug-2020,30-Dec-2021,29-Dec-2022,29-Jun-2023," _
           & "24-Jun-2021,30-Jun-2022"
    Dim Data() As Date
    Data = getDatesFromString(Result)
    
    ' This shows that the data is formatted as Date (vbDate or 7).
    Dim j As Long
    For j = 1 To UBound(Data)
        Debug.Print Data(j), VarType(Data(j))
    Next j
    
    ' This shows that Transpose transforms dates to strings (vbString or 8).
    Dim DataT() As Variant
    DataT = Application.Transpose(Data)
    Dim i As Long
    For i = 1 To UBound(DataT)
        Debug.Print DataT(i, 1), VarType(DataT(i, 1))
    Next i
  
    ' This shows how to copy the array to a 2D one-based one-column array.
    Dim DataR() As Date: ReDim DataR(1 To UBound(Data) + 1, 1 To 1)
    Dim k As Long
    For k = 0 To UBound(Data)
        DataR(k + 1, 1) = Data(k)
        Debug.Print DataR(k + 1, 1), VarType(DataR(k + 1, 1))
    Next k

    With [A1].Resize(UBound(DataT))
        .Clear
        .NumberFormat = "DD-MMM-YYYY"
        .Value = DataT
    End With
    With [B1].Resize(UBound(DataR))
        .Clear
        .NumberFormat = "DD-MMM-YYYY"
        .Value = DataR
        With .Offset(, 1)
            .Clear
            .NumberFormat = "MM/DD/YYYY"
            .Value = DataR
        End With
        With .Offset(, 2)
            .Clear
            .Value = .Offset(, -3).Value 'Formula = "=A1"
            .Value = DataR
        End With
        With .Offset(, 3)
            .Clear
            .NumberFormat = "DD-MMM-YYYY"
            .Value = .Offset(, -4).Value 'Formula = "=A1"
            .Value = DataR
        End With
    End With

End Sub