match duplicates names to sum & subtract for each other

[Omran Y]

Hello
I want creating report in OUTPUT sheet .
it should populate names and sum amounts in DEBIT column and CREDIT column for each duplicates names
and insert TOTAL row to sum whole columns DEBIT,CREDIT . every time I will add new data in ALL sheet so should clear data before brings in OUPUT sheet
the names will be in last location in item .
the data could be 5000 rows

OMRAN.xlsm
	A	B	C	D
1	DATE	DESCRIBE	DEBIT	CREDIT
2	01/01/2023	SALES INVOICE AT300 - OMRAN OMAR	3,000.00
3	02/01/2023	SALES INVOICE AT301 - OMAR ALI	6,000.00
4	03/01/2023	SALES INVOICE AT302 - ALI OMARN	10,000.00
5	04/01/2023	PAID OMRAN OMAR		1,000.00
6	05/01/2023	PAID ALI OMARN		2,000.00
7	06/01/2023	SALES INVOICE AT303 - OMRAN OMAR	3,000.00
8	07/01/2023	SALES INVOICE AT304 - ALI OMARN	50,000.00
9	08/01/2023	PAID OMRAN OMAR		1,200.00
10	09/01/2023	PAID OMRAN OMAR		200.00
all

before

OMRAN.xlsm
	A	B	C	D	E
1	ITEM	NAME	DEBIT	CREDIT	BALANCE
2
3
4
5
OUTPUT

result

OMRAN.xlsm
	A	B	C	D	E
1	ITEM	NAME	DEBIT	CREDIT	BALANCE
2	1	OMRAN OMAR	6,000.00	2,400.00	3,600.00
3	2	OMAR ALI	6,000.00	0.00	6,000.00
4	3	ALI OMARN	60,000.00	2000	58,000.00
5	TOTAL		72,000.00	4,400.00	67,600.00
OUTPUT

Cell Formulas
Range	Formula
E2:E5	E2	=C2-D2
C5:D5	C5	=SUM(C2:C4)

 

[kevin9999]

You could achieve this with a simple formula, rather than messing about with VBA etc. The totals would update if new data is added, you would however, need to add a new name on the OUTPUT sheet if one was added.

Book1
	A	B	C	D	E
1	ITEM	NAME	DEBIT	CREDIT	BALANCE
2	1	OMRAN OMAR	6,000.00	2,400.00	3,600.00
3	2	OMAR ALI	6,000.00	0.00	6,000.00
4	3	ALI OMARN	60,000.00	2,000.00	58,000.00
5	TOTAL		72,000.00	4,400.00	67,600.00
OUTPUT

Cell Formulas
Range	Formula
C2:C4	C2	=SUMPRODUCT(--ISNUMBER(FIND(B2,all!B:B)),all!C:C)
D2:D4	D2	=SUMPRODUCT(--ISNUMBER(FIND(B2,all!B:B)),all!D:D)
E2:E5	E2	=C2-D2
C5:D5	C5	=SUM(C2:C4)

 

[Omran Y]

thanks .
what about before picture , and populate names in column B automatically and insert TOTAL row automatically ?
I no know if all of theses the formula deals with them !
did you read my thread well or not clear ? !

 

[kevin9999]

How do you expect to be able to add new names to the Output sheet when they only form part of the text string in column B of the all sheet?

 

[Georgiboy]

You can give the below a try:

Sub test()
    Dim rng As Range, var As Variant, x As Long
    Dim col As New Collection, tmp As String, c As Variant
    Dim oVar As Variant, z As Long
    Dim wsAll As Worksheet, wsOut As Worksheet
  
    Set wsAll = Sheets("all")
    Set wsOut = Sheets("OUTPUT")
  
    Set rng = wsAll.Range("A1:D" & wsAll.Range("A" & Rows.Count).End(xlUp).Row)
    var = rng.Value
  
    For x = 2 To UBound(var)
        If InStr(var(x, 2), " - ") Then
            var(x, 2) = Right(var(x, 2), Len(var(x, 2)) - InStr(var(x, 2), " - ") - 2)
            tmp = var(x, 2)
        Else
            var(x, 2) = Replace(var(x, 2), "PAID ", "")
            tmp = var(x, 2)
        End If
        On Error Resume Next
            col.Add tmp, CStr(tmp)
        On Error GoTo 0
    Next x

    ReDim oVar(col.Count, 4)
  
    With Application
        For Each c In col
            oVar(z, 0) = z + 1
            oVar(z, 1) = c
            oVar(z, 2) = .SumIf(.Index(rng, , 2), "*" & c & "*", .Index(rng, , 3))
            oVar(z, 3) = .SumIf(.Index(rng, , 2), "*" & c & "*", .Index(rng, , 4))
            oVar(z, 4) = oVar(z, 2) - oVar(z, 3)
            z = z + 1
        Next c
        oVar(z, 0) = "TOTAL"
        oVar(z, 2) = .Sum(Application.Index(rng, , 3))
        oVar(z, 3) = .Sum(Application.Index(rng, , 4))
        oVar(z, 4) = oVar(z, 2) - oVar(z, 3)
    End With
  
    wsOut.UsedRange.Offset(1).Font.Bold = False
    wsOut.UsedRange.Offset(1).ClearContents
    wsOut.Range("A2").Resize(UBound(oVar) + 1, 5) = oVar
    wsOut.Range("A:A").Find("TOTAL").EntireRow.Font.Bold = True
End Sub

It creates the below from your 'all' sheet:

TABLE.xlsm
	A	B	C	D	E
1	ITEM	NAME	DEBIT	CREDIT	BALANCE
2	1	OMRAN OMAR	6000	2400	3600
3	2	OMAR ALI	6000	0	6000
4	3	ALI OMARN	60000	2000	58000
5	TOTAL		72000	4400	67600
OUTPUT

 

[Georgiboy]

You could also replace the below two lines:

        oVar(z, 2) = .Sum(Application.Index(rng, , 3))
        oVar(z, 3) = .Sum(Application.Index(rng, , 4))

With:

        oVar(z, 2) = .Sum(.Index(rng, , 3))
        oVar(z, 3) = .Sum(.Index(rng, , 4))

 

[Omran Y]

How do you expect to be able to add new names to the Output sheet when they only form part of the text string in column B of the all sheet?

big question , difficult question , sorry buddy !
I know you ask me this question , but I wanted advice how do that if the experts guide me the right way , that's why I specify in last location ,Thinking of me could be help ,but doesn't seem help at all .
any option to avoid this problem I will be all my ears .
thanks in advance

 

[Omran Y]

@Georgiboy
thanks works 99%
I need some fixing
when add new names in ALL sheet and when update in OUTPUT sheet will delete borders from the new rows for new added names and also delete borders from TOTAL row . is there any way to add borders and formatting automatically when add new data in OUPUT sheet
also could I add another words in this line

            var(x, 2) = Replace(var(x, 2), "PAID ", "")

for instance : PAID, RECIEVED ,SALARY

 

[Georgiboy]

Maybe the below:

Sub test()
    Dim rng As Range, var As Variant, x As Long
    Dim col As New Collection, tmp As String, c As Variant
    Dim oVar As Variant, z As Long
    Dim wsAll As Worksheet, wsOut As Worksheet
    
    Set wsAll = Sheets("all")
    Set wsOut = Sheets("OUTPUT")
    
    wsOut.Rows("2:" & Rows.Count).Delete
    
    Set rng = wsAll.Range("A1:D" & wsAll.Range("A" & Rows.Count).End(xlUp).Row)
    var = rng.Value
    
    For x = 2 To UBound(var)
        If InStr(var(x, 2), " - ") Then
            var(x, 2) = Right(var(x, 2), Len(var(x, 2)) - InStr(var(x, 2), " - ") - 2)
            tmp = var(x, 2)
        Else
            var(x, 2) = Replace(Replace(Replace(var(x, 2), "PAID ", ""), "RECIEVED ", ""), "SALARY ", "")
            tmp = var(x, 2)
        End If
        On Error Resume Next
            col.Add tmp, CStr(tmp)
        On Error GoTo 0
    Next x

    ReDim oVar(col.Count, 4)
    
    With Application
        For Each c In col
            oVar(z, 0) = z + 1
            oVar(z, 1) = c
            oVar(z, 2) = .SumIf(.Index(rng, , 2), "*" & c & "*", .Index(rng, , 3))
            oVar(z, 3) = .SumIf(.Index(rng, , 2), "*" & c & "*", .Index(rng, , 4))
            oVar(z, 4) = oVar(z, 2) - oVar(z, 3)
            z = z + 1
        Next c
        oVar(z, 0) = "TOTAL"
        oVar(z, 2) = .Sum(.Index(rng, , 3))
        oVar(z, 3) = .Sum(.Index(rng, , 4))
        oVar(z, 4) = oVar(z, 2) - oVar(z, 3)
    End With
    
    With wsOut
        .UsedRange.Offset(1).Font.Bold = False
        .UsedRange.Offset(1).ClearContents
        .Range("A2").Resize(UBound(oVar) + 1, 5) = oVar
        With .Range("A:A").Find("TOTAL")
            .EntireRow.Font.Bold = True
            .Interior.Color = 11573124
        End With
        .UsedRange.Borders.LineStyle = xlContinuous
    End With
End Sub

 

[Omran Y]

@Georgiboy
I appreciate your dedication to writing the code for me . everything is perfect .
thank you so much .