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?
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?
Code:
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