Unable to find date using VBA .find

Question

tmpArr(1, j) may be a date or a string. If it is a date then I need to find it in Range(i4:ck4). The dates in this range are formatted as dates. My code below is not finding my dates. What am I doing wrong?

Data is Code in column A which is alphanumeric and may be 3 characters long. Tbk mnth is column B and is a date.

Code    Tbk Mnth
BX      1-Oct-06
C7      1-Dec-11
C7      1-Apr-12
LA      1-Feb-15
NJ      1-Mar-15

    Dim rng As Range
    Dim tmpArr As Variant
    Dim Dict As Object, tmpDict As Object
    Dim i As Long, j As Long
    Dim v, key
    Dim ws As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim item As Variant
    Dim d As Date

    Set Dict = CreateObject("Scripting.Dictionary")
    Set ws = Worksheets("Data")
    Set ws2 = Worksheets("Plan")
    Set ws3 = Worksheets("test")

    With ws
        Set rng = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 2))

        tmpArr = rng.Value

        For i = LBound(tmpArr, 1) To UBound(tmpArr, 1)
            ' Test if value exists in dictionary. If not add and set up the dictionary item
            If Not Dict.exists(tmpArr(i, 1)) Then
                Set tmpDict = Nothing
                Set tmpDict = CreateObject("Scripting.Dictionary")
                Dict.Add key:=tmpArr(i, 1), item:=tmpDict
            End If
            ' Set nested dictionary to variable to edit it
            Set tmpDict = Nothing
            Set tmpDict = Dict(tmpArr(i, 1))

            ' Test if value exists in nested Dictionary, add if not and initiate counter
            If Not tmpDict.exists(tmpArr(i, 2)) Then
                tmpDict.Add key:=tmpArr(i, 2), item:=1
            Else
                ' Increment counter if it already exists
                tmpDict(tmpArr(i, 2)) = tmpDict(tmpArr(i, 2)) + 1
            End If
            ' Write nested Dictionary back to Main dictionary
            Set Dict(tmpArr(i, 1)) = tmpDict
        Next i

        ' Repurpose array for output setting to maximum possible size (helps with speed of code)
        ReDim tmpArr(LBound(tmpArr, 2) To UBound(tmpArr, 2), LBound(tmpArr, 1) To UBound(tmpArr, 1))
        ' Set starting counters for array
        i = LBound(tmpArr, 1)
        j = LBound(tmpArr, 2)
        ' Convert dictionary and nested dictionary to flat output
        For Each key In Dict
            tmpArr(j, i) = key
            i = i + 1
            For Each v In Dict(key)
                tmpArr(j, i) = v
                tmpArr(j + 1, i) = Dict(key)(v)
                i = i + 1
            Next v
        Next key

        ' Reshape array to actual size
        ReDim Preserve tmpArr(LBound(tmpArr, 1) To UBound(tmpArr, 1), LBound(tmpArr, 2) To i - 1)
        'Change dates less than date in cell 1,9  to overdue and find the row number associated to the code
        d = ws.Cells(1, 9).Value
        For j = LBound(tmpArr, 2) To UBound(tmpArr, 2)
            dte = tmpArr(1, j)
            If dte < d Then
                tmpArr(1, j) = "Overdue"
                b = b + tmpArr(2, j)
            Else
                With ws2.Range("e5:e280")
                    Set c = .find(tmpArr(1, j), LookIn:=xlValues)
                    If Not c Is Nothing Then
                        firstAddress = c.Address
                        firstAddress = Mid(firstAddress, 4, 3)
                        tmpArr(2, j) = firstAddress
                    End If
                End With
            End If    
        Next j

        For j = LBound(tmpArr, 2) To UBound(tmpArr, 2)
            l = Len(tmpArr(1, j))
            Select Case l
            Case Is <= 3
                k = j
                rw = tmpArr(2, k)
            Case 7
                With ws2.Cells(rw, 8)
                    .Value = .Value + tmpArr(2, j)
                End With
            Case 10
                'find column for date numbers
                With ws2.Range("I4:CK4")
                    d = tmpArr(1, j)
                    Set c = .find(DateValue(Format(CDate(d), "dd/mm/yyyy")), LookIn:=xlValues, LookAt:=xlPart)
                    Debug.Print d
                    If Not c Is Nothing Then
                        firstAddress = c.Address
                        firstAddress = Mid(firstAddress, 4, 3)
                    End If                
                End With
            End Select
        Next j

        'See what  tmpArr looks like
        With ws3.Cells(2, 5)
            Range(.Offset(0, 0), .Cells(UBound(tmpArr, 2), UBound(tmpArr, 1))) = Application.Transpose(tmpArr)
        End With
    End With
End Sub

Answer 1

You might use : DateValue() if your date d is set as date format in cells then delete CDate() because Cdate() is used to convert String to date

Case 10
            With ws2.Range("i4:ck4")
            Dim d As Date
                d = tmpArr(1, j)
                    Set c = .find(DateValue(CDate(d)), LookIn:=xlValues, LookAt:=xlPart)
                    If Not c Is Nothing Then
                    firstAddress = c.Address
                    firstAddress = Mid(firstAddress, 4, 3)

                    End If

            End With

        End Select
    Next j

So if your cell is as date format maybe use this one :

Case 10
            With ws2.Range("i4:ck4")
            Dim d As Date
                d = tmpArr(1, j)
                    Set c = .find(DateValue(d), LookIn:=xlValues, LookAt:=xlPart)
                    If Not c Is Nothing Then
                    firstAddress = c.Address
                    firstAddress = Mid(firstAddress, 4, 3)

                    End If

            End With

        End Select
    Next j

Edit

Case 10
                With ws2.Range("i4:ck4")
                Dim d As Date
                    d = tmpArr(1, j)
                        Set c = .find(DateValue(Format(CDate(d), "dd/mm/yyyy")), LookIn:=xlValues, LookAt:=xlPart)
                        If Not c Is Nothing Then
                        firstAddress = c.Address
                        firstAddress = Mid(firstAddress, 4, 3)

                        End If

                End With

            End Select
        Next j