macro merge data based on column and sum values based on two columns and insert column balance

[Ali M]

hi
I have repeated data for each name . so what I want merge duplicate names based on column B and split column C into two columns and if threre repeate item also should merge with comma and summing values in columns D,E and insert column BALANCE to subtract column D from E
first sheet

deb.xlsm
	A	B	C	D	E
1	DATE	NAME	CONDITION	DEBIT	CREDIT
2	20/09/2021	ALI1	INVOICE1	10,000.000
3	21/09/2021	ALI1	INVOICE2	5,000.000
4	22/09/2021	ALI3	INVOICE3	20,000.000
5	23/09/2021	ALI4	INVOICE4	15,000.000
6	24/09/2021	ALI5	INVOICE5	25,000.000
7	25/09/2021	ALI6	INVOICE6	30,000.000
8	26/09/2021	ALI7	INVOICE7	1,500.000
9	27/09/2021	ALI7	INVOICE8	10,000.000
10	28/09/2021	ALI9	INVOICE9	2,000.000
11	29/09/2021	ALI10	INVOICE10	3,500.000
12	30/09/2021	ALI11	INVOICE11	1,500.000
13	01/10/2021	ALI12	INVOICE12	10,000.000
14	02/10/2021	ALI13	INVOICE13	20,000.000
15	03/10/2021	ALI14	INVOICE14	30,000.000
16	04/10/2021	ALI11	INVOICE15	40,000.000
17	05/10/2021	ALI15	INVOICE16	3,000.000
18	06/10/2021	ALI14	VOUCHER1		2,000.000
19	07/10/2021	ALI15	VOUCHER2		1,500.000
20	08/10/2021	ALI16	INVOICE17	30,000.000
21	09/10/2021	ALI16	VOUCHER5		2,000.000
22	10/10/2021	ALI16	VOUCHER6		1,000.00
FIRST

the result should in second sheet . it should create the whole data with headers

deb.xlsm
	A	B	C	D	E	F	G
1	ITEM	NAME	INVOICE NO	VOUCHER NO	DEBIT	CREDIT	BALANCE
2	1	ALI1	INVOICE1,2	-	15,000.000	-	15,000.000
3	2	ALI3	INVOICE3	-	20,000.000	-	20,000.000
4	3	ALI4	INVOICE4	-	15,000.000	-	15,000.000
5	4	ALI5	INVOICE5	-	25,000.000	-	25,000.000
6	5	ALI6	INVOICE6	-	30,000.000	-	30,000.000
7	6	ALI7	INVOICE7	-	1,500.000	-	1,500.000
8	7	ALI7	INVOICE8	-	10,000.000	-	10,000.000
9	8	ALI9	INVOICE9	-	2,000.000	-	2,000.000
10	9	ALI10	INVOICE10	-	3,500.000	-	3,500.000
11	10	ALI11	INVOICE11,15	-	41,500.000	-	41,500.000
12	11	ALI12	INVOICE12	-	10,000.000	-	10,000.000
13	12	ALI13	INVOICE13	-	20,000.000	-	20,000.000
14	13	ALI14	INVOICE14	-	30,000.000	2,000.000	28,000.000
15	14	ALI15	INVOICE16	VOUCHER2	3,000.000	1,500.000	1,500.000
16	15	ALI16	INVOICE17	VOUCHER5,6	30,000.000	3,000.000	27,000.000
SECOND

Cell Formulas
Range	Formula
G2:G16	G2	=E2-F2

 

[alansidman]

Since you have Excel 2016, you have Power Query and Power Pivot as part of your release. In Power Pivot

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"DATE", type date}, {"DEBIT", Int64.Type}, {"CREDIT", type date}}),
    #"Added Custom" = Table.AddColumn(#"Changed Type", "Invoices", each if Text.StartsWith([CONDITION],"INV") then [CONDITION] else null),
    #"Added Custom1" = Table.AddColumn(#"Added Custom", "Voucher", each if Text.StartsWith([CONDITION],"VOU") then [CONDITION] else null),
    #"Removed Columns" = Table.RemoveColumns(#"Added Custom1",{"CONDITION"}),
    #"Changed Type1" = Table.TransformColumnTypes(#"Removed Columns",{{"CREDIT", Int64.Type}})
in
    #"Changed Type1"

This gets your data into a format that will allow you to create a pivot table. You will need to close and load this to a connection and add it to the Data Model when prompted. That will allow you to create some measures in Power Pivot.

Book1
	G	H	I	J	K
1	NAME	InvoiceNr	VoucherNr	Sum of DEBIT	Sum of CREDIT
2	ALI1	INVOICE1 INVOICE2		15000
3	ALI10	INVOICE10		3500
4	ALI11	INVOICE11 INVOICE15		41500
5	ALI12	INVOICE12		10000
6	ALI13	INVOICE13		20000
7	ALI14	INVOICE14	VOUCHER1	30000	2000
8	ALI15	INVOICE16	VOUCHER2	3000	1500
9	ALI16	INVOICE17	VOUCHER5 VOUCHER6	30000	3000
10	ALI3	INVOICE3		20000
11	ALI4	INVOICE4		15000
12	ALI5	INVOICE5		25000
13	ALI6	INVOICE6		30000
14	ALI7	INVOICE7 INVOICE8		11500
15	ALI9	INVOICE9		2000
Sheet1

 

[Ali M]

where is the column BALANCE?

 

[mohadin]

Hi
What about

Sub test()
a = Sheets("sheet1").Cells(1).CurrentRegion
With CreateObject("scripting.dictionary")
  For i = 2 To UBound(a)
    If Not .Exists(a(i, 2)) Then
   .Add a(i, 2), Array(.Count + 1, a(i, 2), a(i, 3), 0, a(i, 4), 0, 0)
    w = .Item(a(i, 2))
   w(6) = w(4) - w(5)
  .Item(a(i, 2)) = w
  Else
  w = .Item(a(i, 2))
  w(5) = IIf(a(i, 5) <> 0, w(5) + a(i, 5), w(5))
  If a(i, 3) Like ("INVOICE*") Then
    w(2) = w(2) & "," & Right(a(i, 3), Len(a(i, 3)) - 7)
    w(4) = w(4) + a(i, 4)
    w(6) = w(4) - w(5)
   .Item(a(i, 2)) = w
  Else
   w(3) = IIf(w(3) = 0, a(i, 3), w(3) & "," & Right(a(i, 3), Len(a(i, 3)) - 7))
   w(5) = w(5) + a(i, 4)
   w(6) = w(4) - w(5)
  .Item(a(i, 2)) = w
 End If
End If
Next
ITM = .items
Sheets("sheet2").Range("a1").Resize(, 7) = Array("ITEM", "NAME", "INVOICE NO", "VOUCHER NO", "DEBIT", "CREDIT", "BALANCE")
Sheets("sheet2").Range("a2").Resize(.Count, 7) = Application.Transpose(Application.Transpose(.items))
Sheets("sheet2").Activate
End With
End Sub

 

[Ali M]

@mohadin that's great ! but I need fixing somthings the value 0 should be" - "and the numbers should show numberforamt as in my OP.

 

[mohadin]

Hi Ali M

Sub test()
a = Sheets("sheet1").Cells(1).CurrentRegion
With CreateObject("scripting.dictionary")
  For i = 2 To UBound(a)
    If Not .Exists(a(i, 2)) Then
   .Add a(i, 2), Array(.Count + 1, a(i, 2), a(i, 3), "-", a(i, 4), "-")
    w = .Item(a(i, 2))
  .Item(a(i, 2)) = w
  Else
  w = .Item(a(i, 2))
  w(5) = IIf(a(i, 5) <> "-", a(i, 5), w(5))
  If a(i, 3) Like ("INVOICE*") Then
    w(2) = w(2) & "," & Right(a(i, 3), Len(a(i, 3)) - 7)
    w(4) = w(4) + a(i, 4)
    w(5) = IIf(a(i, 5) <> "-", "-", w(4))
   .Item(a(i, 2)) = w
  Else
   w(3) = IIf(w(3) = "-", a(i, 3), w(3) & "," & Right(a(i, 3), Len(a(i, 3)) - 7))
   w(5) = IIf(w(5) = "-", "-", w(5) + a(i, 4))
  .Item(a(i, 2)) = w
 End If
End If
Next
ITM = .items
Sheets("sheet2").Range("a1").Resize(, 7) = Array("ITEM", "NAME", "INVOICE NO", "VOUCHER NO", "DEBIT", "CREDIT", "BALANCE")
Sheets("sheet2").Range("a2").Resize(.Count, 6) = Application.Transpose(Application.Transpose(.items))
Sheets("sheet2").Range("a2").Offset(, 6).Resize(.Count).FormulaR1C1 = "=IFERROR(RC[-2]-RC[-1],RC[-2])"
Sheets("sheet2").Activate
End With
End Sub

 

[Ali M]

@mohadin I would create the whole data with formatting whether values or borders in cells . see the pic2 . it should the same thing

 

[mohadin]

Option Explicit
Sub test()
Dim a, w, itm As Variant
Dim i As Long
a = Sheets("sheet1").Cells(1).CurrentRegion
With CreateObject("scripting.dictionary")
  For i = 2 To UBound(a)
    If Not .Exists(a(i, 2)) Then
   .Add a(i, 2), Array(.Count + 1, a(i, 2), a(i, 3), "-", a(i, 4), "-")
    w = .Item(a(i, 2)): .Item(a(i, 2)) = w
  Else
  w = .Item(a(i, 2)): w(5) = IIf(a(i, 5) <> "-", a(i, 5), w(5))
  If a(i, 3) Like ("INVOICE*") Then
    w(2) = w(2) & "," & Right(a(i, 3), Len(a(i, 3)) - 7)
    w(4) = w(4) + a(i, 4): w(5) = IIf(a(i, 5) <> "-", "-", w(4))
   .Item(a(i, 2)) = w
  Else
   w(3) = IIf(w(3) = "-", a(i, 3), w(3) & "," & Right(a(i, 3), Len(a(i, 3)) - 7))
   w(5) = IIf(w(5) = "-", "-", w(5) + a(i, 4))
  .Item(a(i, 2)) = w
 End If: End If
Next
i = .Count: itm = .items
End With
With Sheets("sheet2").Range("a2").Resize(i, 7)
.Offset(-1).Resize(1) = Array("ITEM", "NAME", "INVOICE NO", "VOUCHER NO", "DEBIT", "CREDIT", "BALANCE")
.Resize(, 6).Value = Application.Transpose(Application.Transpose(itm))
.Offset(, 6).Resize(i, 1).FormulaR1C1 = "=IFERROR(RC[-2]-RC[-1],RC[-2])"
      With .Offset(-1).Resize(i + 1)
       .Resize(1).Interior.Color = vbGreen '5287936
       .Resize(1).Font.Bold = True
       .HorizontalAlignment = xlCenter
       .Borders(xlEdgeLeft).LineStyle = xlContinuous
       .Borders(xlEdgeTop).LineStyle = xlContinuous
       .Borders.Weight = xlThin
       .EntireColumn.AutoFit
       End With: End With
Sheets("sheet2").Activate
End Sub

 

[Ali M]

it doesn't merge duplicate value in column F (CREDIT). see th row 14 it gives 1000. it should be 3000. also I have ever said repeatedly should show numberformat as in pic2 like this 3,000.00
may you fix it please?

Monthly Summery.xlsm
	A	B	C	D	E	F	G
1	ITEM	NAME	INVOICE NO	VOUCHER NO	DEBIT	CREDIT	BALANCE
2	1	ALI1	INVOICE1,2	-	15000	-	15000
3	2	ALI3	INVOICE3	-	20000	-	20000
4	3	ALI4	INVOICE4	-	15000	-	15000
5	4	ALI5	INVOICE5	-	25000	-	25000
6	5	ALI6	INVOICE6	-	30000	-	30000
7	6	ALI7	INVOICE7,8	-	11500	-	11500
8	7	ALI9	INVOICE9	-	2000	-	2000
9	8	ALI10	INVOICE10	-	3500	-	3500
10	9	ALI11	INVOICE11,15	-	41500	-	41500
11	10	ALI12	INVOICE12	-	10000	-	10000
12	11	ALI13	INVOICE13	-	20000	-	20000
13	12	ALI14	INVOICE14	VOUCHER1	30000	2000	28000
14	13	ALI15	INVOICE16	VOUCHER2	3000	1500	1500
15	14	ALI16	INVOICE17	VOUCHER5,6	30000	1000	29000
sheet2

Cell Formulas
Range	Formula
G2:G15	G2	=IFERROR(E2-F2,E2)

 

[mohadin]

where are you form Ali?