Aligning two tables

[acube4gh]

I have two table: BANK STATEMENT and CASH BOOK Firstly, want to compare the amounts, if they are equal then Secondly, check the narration if at least three or four letters match, will pair them. If amount is equal but none of the narration matches, will unmatch them.
I have attached an excel to explain it further.
Thsnks

[mdmackillop]

Welcome to VBAX
This will do the matching. It uses the whole text, reducing to 4 characters so takes a little time. I'll leave you to "reassemble" the data into your desired layout.

Option Explicit


Sub test()
Dim x, i As Long, f As Range
Dim r As Range, cel As Range, c As Range, filt As Range

Set r = Range("H:H").SpecialCells(xlCellTypeConstants)
For Each cel In r
x = TextArray(cel.Offset(, -1).Formula)
Range("D:D").AutoFilter 1, "=" & Format(cel, "#,##0.00")
Set filt = Range("C:C").SpecialCells(xlCellTypeVisible)
For i = 0 To UBound(x)
Set f = filt.Find(x(i))
If Not f Is Nothing Then
f.Offset(, -2).Resize(, 4).Cut cel.Offset(, 2)
Exit For
End If
Next i
Next cel
Range("D:D").AutoFilter
End Sub


Function TextArray(Data As String)
Dim i As Long, j As Long, m As Long, y As Long, z As Long
Dim arr()
Dim Limit
ReDim arr(10000)
Limit = 4
i = Len(Data)
y = i - 1
For m = i To Limit Step -1
For j = 1 To i - y
arr(z) = Mid(Data, j, m)
z = z + 1
Next j
y = y - 1
Next m
ReDim Preserve arr(z - 1)
TextArray = arr
End Function

[acube4gh]

Thank very much Sir, i tried the macro and only the first and the tenth row matched, the rest didn't. Maybe i am not doing something right. Please advise.

[mdmackillop]

This is my result on your data
16410

[acube4gh]

Yes Sir, i had the same thing just as in the image you posted and that is not the result i had wanted. i want see the image below;16411

[mdmackillop]

from post #2

I'll leave you to "reassemble" the data into your desired layout.

[acube4gh]

Thanks Sir and i appreciate your efforts very much but i have about 2000 and more rows to match so if after applying the macro and have to reassemble the data, then its just like not using the macro at all and manually match the pair from the scratch.

[mdmackillop]

Option Explicit

Dim LR As Long

Sub test()
Dim x, i As Long, f As Range
Dim r As Range, cel As Range, c As Range, filt As Range

'For test purpose @@@@@@@@@@@@@@@@@@@@
Range("data").Copy Cells(1, 1)
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Application.ScreenUpdating = False

Set r = Range("H:H").SpecialCells(xlCellTypeConstants)
For Each cel In r
x = TextArray(cel.Offset(, -1).Formula)
Range("D:D").AutoFilter 1, "=" & Format(cel, "#,##0.00")
Set filt = Range("C:C").SpecialCells(xlCellTypeVisible)
Range("D:D").AutoFilter
For i = 0 To UBound(x)
Set f = filt.Find(x(i))
If Not f Is Nothing Then
f.Offset(, -2).Resize(, 4).Cut cel.Offset(, 2)
Exit For
End If
Next i
Next cel
Reassemble

'Recheck for duplicate names
Set r = Range("H:H").SpecialCells(xlCellTypeConstants)
For Each cel In r
x = TextArray(cel.Offset(, -1).Formula)
Range("D" & LR & ":D" & Rows.Count).AutoFilter 1, "=" & Format(cel, "#,##0.00")
Set filt = Range("C" & LR & ":C" & Rows.Count).SpecialCells(xlCellTypeVisible)
Range("C" & LR & ":C" & Rows.Count).AutoFilter
For i = 0 To UBound(x)
Set f = filt.Find(x(i))
If Not f Is Nothing Then
cel.EntireRow.Insert
f.Offset(, -2).Resize(, 4).Cut Cells(cel.Row - 1, 1)
LR = Cells(Rows.Count, "G").End(xlUp).Row
Exit For
End If
Next i
Next cel
Application.ScreenUpdating = True
End Sub

Sub Reassemble()

LR = Cells(Rows.Count, "G").End(xlUp).Row
Range("A:A").AutoFilter Field:=1, Criteria1:="<>"
Range("A1:D" & LR).Copy Cells(LR + 2, 1)
Range("A:A").AutoFilter
Range("J1:M" & LR).Cut Cells(1, 1)
End Sub

Function TextArray(Data As String)
Dim i As Long, j As Long, m As Long, y As Long, z As Long
Dim arr()
Dim Limit
ReDim arr(10000)
Limit = 6
i = Len(Data)
y = i - 1
For m = i To Limit Step -1
For j = 1 To i - y
arr(z) = Mid(Data, j, m)
z = z + 1
Next j
y = y - 1
Next m
ReDim Preserve arr(z - 1)
TextArray = arr
End Function

[acube4gh]

Thanks Sir, this is what i had after applying the macro.16414
None of transactions matched.

[mdmackillop]

Here's my workbook

[acube4gh]

Wow, Great work done. it worked like magic but please how do i apply this macro for another set of data of the same columns and has about 2000 rows.

[mdmackillop]

Delete the testing line (see revised code above). The code should run on any number of lines in the same layout, but may take time for 2000 rows.

[acube4gh]

Cant find the revised code above. Can you please re-post it. Thanks very much

[acube4gh]

The macro works up to row 996 the it gives the error in the image16419 below

[mdmackillop]

Post is in #8 above.

I can't test for your error without that amount of data. Delete the first 900 rows and see if it errors at the same location.

[snb]

If you have no knowledge of VBA at all, this forum isn't meant for you. It's purpose is to help people figure out their own VBA projects.

[Aussiebear]

If you have no knowledge of VBA at all, this forum isn't meant for you. It's purpose is to help people figure out their own VBA projects.

Clearly wrong snb. Anybody who visits this forum has the opportunity to learn vba, from the examples the OP's supply and the responses attached to those threads. We should be encouraging others, not putting them down.