Unable to find date using VBA .find - excel

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