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