Public Sub fGetArray()
' On Error GoTo fGetArray_Error
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim CurrentDate As Date
Dim DateTo As Date
Dim strsql As String, EndDate As Date, strKey As Variant
Dim strItem As String, i As Integer, ctlK As Variant
Dim strEndDate As String
Dim strStartDate As String
Set dict = New Scripting.Dictionary
EndDate = DateAdd("d", 42, FirstDateOnGrid)
strEndDate = "#" & Format(EndDate, "mm/dd/yyyy") & "#"
strStartDate = "#" & Format(FirstDateOnGrid, "mm/dd/yyyy") & "#"
strsql = "select dteDate, dteDateTo from tblEvents where dteDate BETWEEN " & strStartDate & " AND " & strEndDate & " OR "
strsql = strsql & "dteDateTo BETWEEN " & strStartDate & " AND " & strEndDate & " ORDER BY dteDate, dteDateTo DESC"
Debug.Print strsql
Set db = CurrentDb()
Set rs = db.OpenRecordset(strsql)
If rs.BOF And rs.EOF Then
GoTo MyExit
End If
Do Until rs.EOF
If CurrentDate < rs!dteDate Then
CurrentDate = rs!dteDate
DateTo = Nz(rs!dteDateTo, CurrentDate)
If DateTo > EndDate Then DateTo = EndDate
' loop from current to date to
Do
strKey = CurrentDate
'need to see if additional dates in range
strItem = DateArry(CurrentDate)
Debug.Print strItem & " cd " & CurrentDate
dict.Add strKey, CStr(strItem)
CurrentDate = CurrentDate + 1
Loop Until CurrentDate > DateTo
End If
rs.MoveNext
Loop