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