0

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"

Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
Kiran
  • 167
  • 1
  • 9

3 Answers3

3

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

Naresh
  • 2,984
  • 2
  • 9
  • 15
  • Hi, thanks yes for NSE :), the output I am getting is "02-Jul-2020,06-Aug-2020,09-Jul-2020,13-Aug-2020,16-Jul-2020,20-Aug-2020,23-Jul-2020,24-Jun-2021,24-Sep-2020,25-Mar-2021,27-Aug-2020,29-Dec-2022,29-Jun-2023,30-Dec-2021,30-Jul-2020,30-Jun-2022,31-Dec-2020" but I need as per expiry... date column.. – Kiran Jun 26 '20 at 05:36
  • Not sure why you are getting different results. See added image. May be its the date format in your system. Do you want the string to be split into a sorted column? What is date format in your excel formula bar? – Naresh Jun 26 '20 at 05:49
  • actually I am passing the string result to the function, not using it as excel function. can it be sorted? – Kiran Jun 26 '20 at 06:01
  • While the sorting is OK, the Question is expanded with `expiry date column` which is not mentioned in the question, @Kiran WHY ? – Luuk Jun 26 '20 at 06:05
  • Agree with @Luuk. Kiran, to avoid long chat, please edit the question with the desired result may be with a sample screenshot. Also, instead of entering the sorted result as a string in your excel function, you can mention this "SortArr" function in place of the string in your excel function. Remember, there is [limit on number of characters](https://support.microsoft.com/en-us/office/excel-specifications-and-limits-1672b34d-7043-467e-8e27-269d656771c3) we enter in an excel function – Naresh Jun 26 '20 at 06:06
  • Naresh, the above "result" is output from a function, but I want to format that output to as "02-Jul-2020,09-Jul-2020,16-Jul-2020,23-Jul-2020,30-Jul-2020,06-Aug-2020,13-Aug-2020,20-Aug-2020,27-Aug-2020,24-Sep-2020,31-Dec-2020,25-Mar-2021,24-Jun-2021,30-Dec-2021,30-Jun-2022,29-Dec-2022,29-Jun-2023". .. no excel columns involved here. – Kiran Jun 26 '20 at 06:23
  • instead of excel column, can u try passing the result to ur function directly, u will get different sort. – Kiran Jun 26 '20 at 06:25
  • So, instead of A2 in my function you need to mention your function giving this result. In short, wrap your function with SortArr function. .. Like `=SortArr(YourFunction,",",0)` – Naresh Jun 26 '20 at 06:29
  • Naresh, still getting same output, this is my function where I am removing duplicates and getting unique output, only need to sort as per expiry `Public Function unik(rng As Range) As String Dim c As Collection, r As Range Set c = New Collection On Error Resume Next For Each r In rng v = r.Value c.Add v, CStr(v) If Err.Number = 0 Then unik = unik & "," & v Else Err.Number = 0 End If Next r On Error GoTo 0 unik = Mid(unik, 2) End Function ` – Kiran Jun 26 '20 at 06:46
  • Ok.. Got it .. So have you tried `=SortArr(unik(Range),",",0)` ... I tried; no error for dates. That's why I asked you date format in the formula bar. Enter a date in a cell and see the formula bar how it looks. – Naresh Jun 26 '20 at 06:55
  • Let us [continue this discussion in chat](https://chat.stackoverflow.com/rooms/216699/discussion-between-kiran-and-naresh-bhople). – Kiran Jun 26 '20 at 07:13
  • 1
    yes for dates, we need to use datevalue. when comparing between arrays.... that resolved the issue. – Kiran Jun 26 '20 at 08:16
  • Glad to hear that. .. edited the answer as well mentioning it s for dates. Thanks – Naresh Jun 26 '20 at 08:17
2

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
VBasic2008
  • 44,888
  • 5
  • 17
  • 28
2

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")))
JvdV
  • 70,606
  • 8
  • 39
  • 70