The Key is already associated with an element in this collection (1 Viewer)

ria4life

Registered User.
Local time
Today, 02:48
Joined
Feb 24, 2016
Messages
40
Any help is greatly appreciated:

Im using code i found on the web to integrate in my application.
I keep getting this error: The Key is already associated with an element in this collection
associated with this line:

Code:
colCalendarDates1.Add strCode1, strDate1

Full Code below:

Code:
Option Compare Database
Option Explicit


'// AUTHOR: Dom DXecutioner (Dominick G. Hernandez)

Private m_strCTLLabel  As String
Private m_strCTLLabelHeader As String
Private colCalendarDates1 As Collection

Function getCalendarData() As Boolean
Dim rs As DAO.Recordset
Dim strDate1 As String
Dim strCode1 As String
Dim i As Integer
    Set rs = CurrentDb.OpenRecordset("qry_employeeAttendance", dbOpenDynaset)
    Set colCalendarDates1 = New Collection
    With rs
        If (Not .BOF) Or (Not .EOF) Then
            .MoveLast
            .MoveFirst
        End If
        If .RecordCount > 0 Then
            For i = 1 To .RecordCount
                strDate1 = .Fields("attendanceDate")
                strCode1 = .Fields("statusCode")
                colCalendarDates1.Add strCode1, strDate1
                .MoveNext
            Next i
        End If
        .Close
    End With
    '// return date collection
    Set rs = Nothing
End Function

Public Sub loadReportYearCalendar(theReport As Report)
Dim i As Integer
Dim datStart As Date
Dim rptControl As Report

    m_strCTLLabel = "labelCELL"
    m_strCTLLabelHeader = "labelDAY"
    
    '// load dates into our collection
    Call getCalendarData
    
    With theReport
        '// get the first month of the year
        datStart = "1/1/" & Year(Date)
        '// add the year to the report's label
        .Controls("labelCalendarHeaderLine2").Caption = Year(datStart) & " iCalendar"
        For i = 1 To 12
            '// set pointer to subreport control hosting the mini-calendar
            Set rptControl = .Controls("childCalendarMonth" & i).Report
            '// run procedure to populate control with it's respective year
            Call loadReportCalendar(rptControl, datStart)
            '// reset and obtain first day of the following month
            datStart = DateAdd("m", 1, datStart)
        Next i
    End With
    '// clean up
    Set colCalendarDates1 = Nothing
    Set rptControl = Nothing
End Sub


Public Sub loadReportCalendar(theReport As Report, Optional StartDate As Date, Optional theHeaderColor As Variant)
Dim i As Integer
Dim intCalDay As Integer
Dim datStartDate As Date
Dim intWeekDay As Integer
    
    datStartDate = StartDate
    intWeekDay = Weekday(datStartDate)
    
    With theReport
        
        .Controls("labelMONTH").Caption = Format(StartDate, "mmmm")
        
        '// change the day label's backcolor if necessary
        If Not (IsMissing(theHeaderColor)) Then
            For i = 1 To 7
                .Controls("labelDayHeader" & i).BackColor = theHeaderColor
            Next
        End If

        For i = 1 To 42
            With .Controls(m_strCTLLabel & i)
                If (i >= intWeekDay) And (Month(StartDate) = Month(datStartDate)) Then
                    If (datStartDate = Date) Then
                        .BackColor = vbYellow
                    End If
                    
                    '// =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
                    '// =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
                    
               
                    On Error Resume Next
                    
                    Dim strCaption As String
                    Dim strKey As String
                    
                    strKey = datStartDate
                    strCaption = ""
                    strCaption = colCalendarDates1.Item(strKey)
                    colCalendarDates1.Remove strKey
                                        
                    If strCaption = vbNullString Then
                        .Caption = Day(datStartDate)
                        .Bold = False
                    Else
                        .Caption = strCaption
                        .Bold = True
                        Select Case strCaption
                            Case "v"
                                .BackColor = vbBlue
                            Case "s"
                                .BackColor = vbRed
                            Case "l"
                                .BackColor = 39423
                        End Select
                        .ForeColor = vbWhite
                    End If
                    
                    '// =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
                    '// =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
                    
                    datStartDate = DateAdd("d", 1, datStartDate)
                Else
                    .Caption = ""
                End If
            End With
        Next i
    End With
    
End Sub
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 05:48
Joined
May 21, 2018
Messages
8,463
colCalendarDates1.Add strCode1, strDate1

strCode1 is the valueand strdate1 is the key of the collection

the key has to be unique you are repeating
 

ria4life

Registered User.
Local time
Today, 02:48
Joined
Feb 24, 2016
Messages
40
Perfect..thank you.
There were multiples in the data filed and your solution was on point.
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 05:48
Joined
May 21, 2018
Messages
8,463
I did not look at all your code, but the key in a collection does not do much. You can not get an item by key. If you need to get an item by key look at the Dictionary object. It is similar to a collection but more robust.
 

Users who are viewing this thread

Top Bottom