Delete customer if contains the same amount otherwise just subtract between two sheets

[Alaa mg]

Hi
I want deleting any name contains the same amount in NAMES sheet after comparison with BAD DEBTS sheet.
should match column C in NAMES sheet with column D in BAD DEBTS and search for the same amount in AMOUNT column then should delete the whole row for the customer , if doesn't contain the same amount in NAMES sheet after comparison with BAD DEBTS sheet then just subtract amount in NAMES sheet from BAD DEBTS sheet( be careful will repeat customers in BAD DEBTS so should merge amount for duplicate customer before delete the row if equal the same amount or subtraction.also should re autonumbering in column A and sum the AMOUNT column.
the result should be in PR.
I would macro to deal about big data for each sheet.

BAD DEBTS.xlsm
	A	B	C	D
1	ITEM	DETAILS	NAMES	AMOUNT
2	1	OPENING BALANCE 08/01/22	Ala	1,200.00
3	2	OPENING BALANCE 11/01/22	Aln	3,000.00
4	3	OPENING BALANCE 17/01/22	Alm	1,500.00
5	4	OPENING BALANCE 17/01/22	Alaa	1,200.00
6	5	OPENING BALANCE 17/01/22	Allia	1,000.00
7	6	OPENING BALANCE 17/01/22	Aliaa	1,100.00
8	7	OPENING BALANCE 17/01/22	Anila	1,500.00
9	8	OPENING BALANCE 17/01/22	Aali	1,000.00
10	9	OPENING BALANCE 17/01/22	Aml	1,100.00
11	TOTAL			12,600.00
NAMES

BAD DEBTS.xlsm
	A	B	C	D	E
1	ITEM	DATE	INVOICE NO	NAMES	AMOUNT
2	1	01/01/2024	INV AL-00	Ala	1,200.00
3	2	02/01/2024	INV AL-01	Aln	500.00
4	3	03/01/2024	INV AL-02	Aln	200.00
5	4	04/01/2024	INV AL-03	Alaa	200.00
6	5	05/01/2024	INV AL-04	Allia	200.00
7	6	06/01/2024	INV AL-05	Allia	800.00
BAD DEBTS

result

BAD DEBTS.xlsm
	A	B	C	D
1	ITEM	DETAILS	NAMES	AMOUNT
2	1	OPENING BALANCE 11/01/22	Aln	2,300.00
3	2	OPENING BALANCE 17/01/22	Alm	1,500.00
4	3	OPENING BALANCE 17/01/22	Alaa	1,000.00
5	4	OPENING BALANCE 17/01/22	Aliaa	1,100.00
6	5	OPENING BALANCE 17/01/22	Anila	1,500.00
7	6	OPENING BALANCE 17/01/22	Aali	1,000.00
8	7	OPENING BALANCE 17/01/22	Aml	1,100.00
9	TOTAL			9,500.00
RR

 

[igold]

How about this, it tested and works with your given data as shown.

Sub Sum_Values2()

    Dim wsN As Worksheet: Set wsN = Worksheets("Names")
    Dim wsBD As Worksheet: Set wsBD = Worksheets("BAD DEBTS")
    Dim wsRR As Worksheet: Set wsRR = Worksheets("RR")
    Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
    Dim a, arr, arr2, arr3, nams, rng As Range
    Dim r As Long, c As Long, i As Long, ct As Long, x As Long, d As String, lRow As Long
    
    Application.ScreenUpdating = False
    a = wsBD.Range("D2:E" & Cells(Rows.Count, 4).End(xlUp).Row)
    nams = wsN.Range("A2:D" & Cells(Rows.Count, 3).End(xlUp).Row)
    ct = 1
    For i = 1 To UBound(a)
          dic(a(i, 1)) = dic(a(i, 1)) + a(i, 2)
    Next

    ReDim arr3(1 To dic.Count, 1 To 2)
    ReDim res(1 To UBound(nams), 1 To 4)

    arr = dic.keys
    arr2 = dic.items
    For r = 1 To UBound(arr) + 1
        arr3(r, 1) = arr(r - 1)
        arr3(r, 2) = arr2(r - 1)
    Next

    For c = 1 To UBound(nams)
        For x = 1 To UBound(arr3)
            If nams(c, 3) = arr3(x, 1) Then
                    nams(c, 4) = nams(c, 4) - arr3(x, 2)
                    If nams(c, 4) = 0 Then nams(c, 4) = ""
            End If
        Next
    Next
    
    With wsRR
        .Activate
        .UsedRange.Offset(1, 0).Clear
        .Range("A2").Resize(UBound(nams, 1), UBound(nams, 2)) = nams
        lRow = wsRR.Cells(Rows.Count, 3).End(xlUp).Row
        .Range("A2").Formula = "=ROW()-1"
        .Range("A2").AutoFill wsRR.Range("A2:A" & lRow)
        .Range("D2:D" & lRow).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        lRow = wsRR.Cells(Rows.Count, 3).End(xlUp).Row
        .Range("A" & lRow + 1) = "TOTAL"
        Set rng = wsRR.Range("D2:D" & lRow)
        d = rng.Address(False, False)
        x = WorksheetFunction.Sum(Range(d))
        .Range("D" & lRow + 1) = x
        .Range("A" & lRow + 1 & ":D" & lRow + 1).Interior.Color = RGB(255, 255, 0)
    End With
    Application.ScreenUpdating = True
    
End Sub

 

[Alaa mg]

Thanks
it shows mismatch error in this line

nams(c, 4) = nams(c, 4) - arr3(x, 2)

this case when there is no data in RR sheet when try run macro from first time.

 

[igold]

I run the code with the RR sheet being blank and it works fine. There is of course no header row written but it is otherwise populated correctly.

 

[igold]

Make sure you are run it with the Names tab active. If you run it with the RR tab active and it is blank, it will throw the error you described... You can add a line of code at the beginning to activate the Names tab to avoid this issue.

 

[Alaa mg]

Make sure you are run it with the Names tab active. If you run it with the RR tab active and it is blank, it will throw the error you described... You can add a line of code at the beginning to activate the Names tab to avoid this issue.

yes this is what I did it.

 

[igold]

And is the code working correctly?

 

[Alaa mg]

And is the code working correctly?

not completely , there is no formatting and borders for headers or numberformat .

BAD DEBTS.xlsm
	A	B	C	D
1
2	1	OPENING BALANCE 11/01/22	Aln	2300
3	2	OPENING BALANCE 17/01/22	Alm	1500
4	3	OPENING BALANCE 17/01/22	Alaa	1000
5	4	OPENING BALANCE 17/01/22	Aliaa	1100
6	5	OPENING BALANCE 17/01/22	Anila	1500
7	6	OPENING BALANCE 17/01/22	Aali	1000
8	7	OPENING BALANCE 17/01/22	Aml	1100
9	TOTAL			9500
RR

Cell Formulas
Range	Formula
A2:A8	A2	=ROW()-1

you can see my result in OP.

 

[igold]

I was working under the assumption that the sheet would have had the formatting already applied and that the code would fill the values. Formatting is the easy stuff. Do you need additional code that will write the Header Row...

 

[Alaa mg]

it's not problem for me I do manually , but the problem your code delete number format(#,##0.00) also delete borders when I do manually .
do you have any idea to fix it?