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 GoTo 0
    
    'Compare Date and Amount
    For lngCount = 1 To coll.Count
        Set Found = xlWs2.Range("A:A").Find(What:=Format(coll(lngCount), "m/d/yy"), _
                                              LookIn:=xlValues, _
                                              lookat:=xlWhole, _
                                              SearchOrder:=xlByRows, _
                                              SearchDirection:=xlNext, _
                                              MatchCase:=False)
        If Not Found 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("A:A").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