Searching Data with Date Crietria From and To with EVALUATE function but Get Type Mismatch

[NimishK]

Hello

I am trying to search Data by Date Criteria ie data (from Date) to (to date)
if the Date exists between FromDate toDate then it should display the dates with data Else Date should not be highlited if not exists.
also thought of incorporating "EVALUATE" but i get Type mismatch
the data of date exists in sheet MainData which needs to be searched FromDate ToDate and displayed in Sheet3

Below Code modified from KutoolsforExcel20151202 and incorporating Evaluate Function marked in Red Bold where i get Type mismatch Error

Public Sub dateSearchSub()
    Dim xStrSearch As String, xDateSearch As Date
    Dim xOut As Worksheet
    Dim xWk As Worksheet
    Dim xRow As Long, srchdRow As Long
    Dim xFound As Range
    Dim xStrAddress As String
    Dim xUpdate As Boolean
    Dim xCount As Long
    Dim lstRow As Long
    Dim matchRange As Range
    Dim a As Integer, b As Integer
    Dim matchValueString As String
    
[COLOR=#ff0000]Dim dv As Long[/COLOR]
[COLOR=#ff0000][B]dv = DateValue(txtToDate) - DateValue(txtFromDate)[/B][/COLOR]

    On Error GoTo ErrHandler
   ''''' 'xDateSearch = Format(txtFromDate.Text, "dd-mm-yy")
[COLOR=#ff0000][B]    xDateSearch = Evaluate("datevalue(""" & txtFromDate & """) + (row(1:" & dv + 1 & ")-1)")[/B][/COLOR]

    xUpdate = Application.ScreenUpdating
    Application.ScreenUpdating = False
    Set xOut = Worksheets("Sheet3")
    xRow = 1
    With xOut
        
        .Cells(xRow, 1) = "Code No."
        .Cells(xRow, 2) = "Name"
        .Cells(xRow, 3) = "Searched Date" 
        
        .Cells(xRow, 4) = "Searched Date in Cell"
        .Cells(xRow, 5) = "Amount"
        .Cells(xRow, 6) = "Amount Recd."
        .Cells(xRow, 7) = "Amount Recivables"
        
                Set xWk = Worksheets("MainData")
[COLOR=#ff0000]                Set xFound = xWk.UsedRange.Find(xDateSearch)[/COLOR]
                lstRow = xWk.Cells(.Rows.Count, 1).End(xlUp).Row
                
                If Not xFound Is Nothing Then
                    xStrAddress = xFound.Address
                End If
                Do
                    If xFound Is Nothing Then
                        Exit Do
                    Else
                        xCount = xCount + 1
                        xRow = xRow + 1
                        .Cells(xRow, 1) = xWk.Range(xWk.Cells(xFound.Row, 1), xWk.Cells(xFound.Row, 1))
                        .Cells(xRow, 2) = xWk.Range(xWk.Cells(xFound.Row, 2), xWk.Cells(xFound.Row, 2))
                        .Cells(xRow, 3) = xFound.Value
                       End If
  
             Set xFound = xWk.Cells.FindNext(after:=xFound)
                Loop While xStrAddress <> xFound.Address
           
    End With
    MsgBox xCount & "cells have been found"
ExitHandler:
    Set xOut = Nothing
    Set xWk = Nothing
    Application.ScreenUpdating = xUpdate
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler

End Sub

Public Sub FormR()
'Dim i As Long
'i = DateValue(txtToDate) - DateValue(txtFromDate)
'With Range("A1").Resize(i + 1)
'    .Value = Evaluate("datevalue(""" & txtFromDate & """) + (row(1:" & i + 1 & ")-1)")
'    .NumberFormat = "dd-mmm-yyyy"
'End With
End Sub

Thanks NimishK

 

[NimishK]

Extremely Sorry Guys. I made mistake by using the logic of EVALUATING. I realised that i needed to create array of Dates as now marked in RED-BOLD.
Now only issue is that how can the following code search the Array of Dates. Your guidance shall be appreciated
Re-coded as below

Public Sub dateSearchSub()
    Dim xStrSearch As String, xDateSearch As Date
    Dim xOut As Worksheet
    Dim xWk As Worksheet
    Dim xRow As Long, srchdRow As Long
    Dim xFound As Range
    Dim xStrAddress As String
    Dim xUpdate As Boolean
    Dim xCount As Long
    Dim lstRow As Long
    Dim matchRange As Range
    Dim a As Integer, b As Integer
    Dim matchValueString As String
    Dim fromDate As Date, toDate As Date, d As Date
    Dim datesArray() As Date, numDates As Long
    Dim i As Long


[COLOR=#ff0000][B]    fromDate = Format(txtFromDate.Text, "dd-mm-yy")[/B][/COLOR]
[COLOR=#ff0000][B]    toDate = Format(txtToDate.Text, "dd-mm-yy")[/B][/COLOR]

[COLOR=#ff0000][B]    numDates = 0[/B][/COLOR]

[COLOR=#ff0000][B]    For d = fromDate To toDate[/B][/COLOR]
[COLOR=#ff0000][B]           ReDim Preserve datesArray(0 To numDates)[/B][/COLOR]
[COLOR=#ff0000][B]           datesArray(numDates) = d[/B][/COLOR]
[COLOR=#ff0000][B]           numDates = numDates + 1[/B][/COLOR]
[COLOR=#ff0000][B]    Next d[/B][/COLOR]
[COLOR=#ff0000][B]
''''''  [/B][/COLOR][COLOR=#008000][B]to search xDateSearch = datesArray(i)[/B][/COLOR]
    
On Error GoTo ErrHandler

    xUpdate = Application.ScreenUpdating
    Application.ScreenUpdating = False
    Set xOut = Worksheets("Sheet3")
    xRow = 1
    With xOut
        
        .Cells(xRow, 1) = "Code No."
        .Cells(xRow, 2) = "Name"
        .Cells(xRow, 3) = "Searched Date" 
        
        .Cells(xRow, 4) = "Searched Date in Cell"
        .Cells(xRow, 5) = "Amount"
        .Cells(xRow, 6) = "Amount Recd."
        .Cells(xRow, 7) = "Amount Recivables"
        
                Set xWk = Worksheets("MainData")
                lstRow = xWk.Cells(.Rows.Count, 1).End(xlUp).Row
                
                If Not xFound Is Nothing Then
                    xStrAddress = xFound.Address
                End If
                Do
                    If xFound Is Nothing Then
                        Exit Do
                    Else
                        xCount = xCount + 1
                        xRow = xRow + 1
                        .Cells(xRow, 1) = xWk.Range(xWk.Cells(xFound.Row, 1), xWk.Cells(xFound.Row, 1))
                        .Cells(xRow, 2) = xWk.Range(xWk.Cells(xFound.Row, 2), xWk.Cells(xFound.Row, 2))
                        .Cells(xRow, 3) = xFound.Value
                       End If
  
                  Set xFound = xWk.Cells.FindNext(after:=xFound)
                Loop While xStrAddress <> xFound.Address
           
    End With
    MsgBox xCount & "cells have been found"
ExitHandler:
    Set xOut = Nothing
    Set xWk = Nothing
    Application.ScreenUpdating = xUpdate
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler

End Sub