How to match Date and Amount from sheet1 with sheet2 data with the same date and amount?

I don't know what's wrong with my script..
it's not working.. or if it work.. it only copy the same date even the amount is different..
it should be same date and same amount..
and it should cut the data from sheet 2 so reconciling it would be much easier since i will only reconcile the items that are left from sheet 2..


can anyone help me?

Sub MatchOnlineFundTransfer()
    
    Application.ScreenUpdating = False
    
    Dim xlWs1 As Worksheet, xlWs2 As Worksheet
    Dim xlRngDate As Range
    Dim coll As New Collection
    Dim FirstFound As String
    Dim lngCount As Long, dCount As Long
    
    Set xlWs1 = ThisWorkbook.Worksheets("Sheet1")
    Set xlWs2 = ThisWorkbook.Worksheets("Sheet2")
    
    'Get Unique dates
    On Error Resume Next
    For Each xlRngDate In xlWs1.Columns(1).SpecialCells(xlCellTypeConstants, xlNumbers)
        If IsEmpty(xlRngDate.Offset(, 7)) Then
            coll.Add CDate(xlRngDate.Value), CStr(xlRngDate.Value)
        End If
    Next xlRngDate
    On Error Resume Next

    'Compare Date and Amount
    For lngCount = 1 To coll.Count
        Set Found = xlWs2.Range("C:C").Find(What:=CDate(coll(lngCount)), _
                                              LookIn:=xlValues, _
                                              lookat:=xlWhole, _
                                              SearchOrder:=xlByRows, _
                                              SearchDirection:=xlNext, _
                                              MatchCase:=False)
        If Not xlRngDate Is Nothing Then
            If WorksheetFunction.CountIf(xlWs1.Columns(1), CDate(coll(lngCount))) = WorksheetFunction.CountIf(xlWs2.Columns(1), CDate(coll(lngCount))) Then
                Set xlRngDate = xlWs1.Columns(1).Find(What:=CDate(coll(lngCount)), LookIn:=xlFormulas, lookat:=xlWhole)
                counter = counter + 1
                FirstFound = Found.Address
                Do
                If Found.Offset(, 5).Value = xlRngDate.Offset(, 1).Value Then
                    Found.Offset(, -2).Resize(, 8).Cut Destination:=xlRngDate.Offset(, 5)
                    xlRngDate.Offset(, 7).PasteSpecial xlPasteAll
                    counter = counter + 1
                    Exit Do
                    End If
                    Set Found = xlWs2.Range("H:H").FindNext(After:=Found)
                    Loop Until Found.Address = FirstFound
                End If
            End If
    Next
    Application.ScreenUpdating = True
    MsgBox counter & " Data Had Matched", vbInformation, "Matching Check Data Complete"
    
End Sub