Extract duplicates dates and insert TOTAL row for each duplicates dates

[Alaa mg]

Hello
I need macro for 8000 rows to extract duplicates dates in columns A B,C,F and ignore columns D,E in result sheet to DATE sheet and .
and insert TOTAL row for each duplicates dates .

DATE.xlsm
	A	B	C	D	E	F
1	DATE	S.N	ACRRUING/CASH	DEBIT	CREDIT	BALANCE
2	01/01/2024	1	CASH IN CS200	2,000.00		2,000.00
3	01/01/2024	2	BANK IN BN2000	2,000.00		4,000.00
4	01/01/2024	3	CASH IN CS2001	3,100.00		7,100.00
5	01/01/2024	4	CASH IN CS204		730.00	6,370.00
6	01/01/2024	5	CASH IN CS205		1,040.00	5,330.00
7	01/01/2024	6	BANK IN BN2001		620.00	4,710.00
8	01/01/2024	7	CASH IN CS203	200.00		4,910.00
9	01/01/2024	8	BANK IN BN2002	400.00		5,310.00
10	02/01/2024	9	CASH IN CS2003	1,030.00		6,340.00
11	02/01/2024	10	CASH IN CS206		480.00	5,860.00
12	03/01/2024	11	CASH IN CS207		1,040.00	4,820.00
13	03/01/2024	12	BANK IN BN2004		620.00	4,200.00
14	TOTAL			8,730.00	4,530.00	4,200.00
RESULT

Cell Formulas
Range	Formula
F2,F14	F2	=D2-E2
F3:F13	F3	=F2+D3-E3
D14:E14	D14	=SUM(D2:D13)

DATE.xlsm
	A	B	C	D	E
1	ITEM	DATE	S.N	ACRRUING/CASH	BALANCE
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
DATE

what I want like this

DATE.xlsm
	A	B	C	D	E
1	ITEM	DATE	S.N	ACRRUING/CASH	BALANCE
2	1	01/01/2024	1	CASH IN CS200	2,000.00
3	2	01/01/2024	2	BANK IN BN2000	4,000.00
4	3	01/01/2024	3	CASH IN CS2001	7,100.00
5	4	01/01/2024	4	CASH IN CS204	6,370.00
6	5	01/01/2024	5	CASH IN CS205	5,330.00
7	6	01/01/2024	6	BANK IN BN2001	4,710.00
8	7	01/01/2024	7	CASH IN CS203	4,910.00
9	8	01/01/2024	8	BANK IN BN2002	5,310.00
10		TOTAL			39,730.00
11	1	02/01/2024	9	CASH IN CS2003	6,340.00
12	2	02/01/2024	10	CASH IN CS206	5,860.00
13		TOTAL			12,200.00
14	1	03/01/2024	11	CASH IN CS207	4,820.00
15	2	03/01/2024	12	BANK IN BN2004	4,200.00
16		TOTAL			9,020.00
DATE

Cell Formulas
Range	Formula
E10	E10	=SUM(E2:E9)
E13,E16	E13	=SUM(E11:E12)

in DATE sheet should clear data before brings data.

 

[kevin9999]

Please try the following on a copy of your workbook. Assumes the structure is exactly as you describe above before running the code.

Option Explicit
Sub Alaamg()
    Application.ScreenUpdating = False
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("RESULT")
    Set ws2 = Worksheets("DATE")
    Dim rngList As Range, rngCriteria As Range, rngCopyTo As Range
    
    Set rngList = ws1.Range("A1").CurrentRegion
    ws1.Range("J1").Resize(2, 1).Value2 = Application.Transpose(Array("S.N", "<>"))
    Set rngCriteria = ws1.Range("J1").CurrentRegion
    ws2.Range("A1").CurrentRegion.Offset(1).ClearContents
    Set rngCopyTo = ws2.Range("B1:E1")
    rngList.AdvancedFilter xlFilterCopy, rngCriteria, rngCopyTo
    rngCriteria.ClearContents
    
    With ws2.Range("A2:A" & ws2.Cells(Rows.Count, "C").End(xlUp).Row)
        .FormulaR1C1 = "=IF(R[-1]C2<>RC2,1,1+R[-1]C)"
        .Value = .Value
    End With
    
    Dim i As Long
    For i = ws2.Cells(Rows.Count, "C").End(xlUp).Row To 3 Step -1
        If ws2.Cells(i, 1) = 1 Then ws2.Rows(i).EntireRow.Insert
    Next i
    
    Dim r As Range
    For Each r In ws2.Range("E:E").SpecialCells(xlCellTypeConstants).Areas
        r.Cells(r.Count + 1).Value = WorksheetFunction.Sum(r)
        r.Cells(r.Count + 1).Offset(, -3).Value = "TOTAL"
    Next r
    Application.ScreenUpdating = False
End Sub

RESULT sheet used:

Book1
	A	B	C	D	E	F
1	DATE	S.N	ACRRUING/CASH	DEBIT	CREDIT	BALANCE
2	1/01/2024	1	CASH IN CS200	2,000.00		2,000.00
3	1/01/2024	2	BANK IN BN2000	2,000.00		4,000.00
4	1/01/2024	3	CASH IN CS2001	3,100.00		7,100.00
5	1/01/2024	4	CASH IN CS204		730.00	6,370.00
6	1/01/2024	5	CASH IN CS205		1,040.00	5,330.00
7	1/01/2024	6	BANK IN BN2001		620.00	4,710.00
8	1/01/2024	7	CASH IN CS203	200.00		4,910.00
9	1/01/2024	8	BANK IN BN2002	400.00		5,310.00
10	2/01/2024	9	CASH IN CS2003	1,030.00		6,340.00
11	2/01/2024	10	CASH IN CS206		480.00	5,860.00
12	3/01/2024	11	CASH IN CS207		1,040.00	4,820.00
13	3/01/2024	12	BANK IN BN2004		620.00	4,200.00
14	TOTAL			8,730.00	4,530.00	4,200.00
15
RESULT

Cell Formulas
Range	Formula
F2,F14	F2	=D2-E2
F3:F13	F3	=F2+D3-E3
D14:E14	D14	=SUM(D2:D13)

DATE sheet before running code:

Book1
	A	B	C	D	E
1	ITEM	DATE	S.N	ACRRUING/CASH	BALANCE
2
3
4
5
6
7
DATE

DATE sheet after running code:

Book1
	A	B	C	D	E
1	ITEM	DATE	S.N	ACRRUING/CASH	BALANCE
2	1	1/01/2024	1	CASH IN CS200	2,000.00
3	2	1/01/2024	2	BANK IN BN2000	4,000.00
4	3	1/01/2024	3	CASH IN CS2001	7,100.00
5	4	1/01/2024	4	CASH IN CS204	6,370.00
6	5	1/01/2024	5	CASH IN CS205	5,330.00
7	6	1/01/2024	6	BANK IN BN2001	4,710.00
8	7	1/01/2024	7	CASH IN CS203	4,910.00
9	8	1/01/2024	8	BANK IN BN2002	5,310.00
10		TOTAL			39,730.00
11	1	2/01/2024	9	CASH IN CS2003	6,340.00
12	2	2/01/2024	10	CASH IN CS206	5,860.00
13		TOTAL			12,200.00
14	1	3/01/2024	11	CASH IN CS207	4,820.00
15	2	3/01/2024	12	BANK IN BN2004	4,200.00
16		TOTAL			9,020.00
17
DATE

 

[DanteAmor]

Here another macro to try:

Sub Insert_Total()
  Dim a As Variant, b As Variant
  Dim ant As Double, tot As Double
  Dim i As Long, k As Long, n As Long
  
  a = Sheets("RESULT").Range("A1:F" & Sheets("RESULT").Range("C" & Rows.Count).End(3).Row + 1).Value
  ReDim b(1 To UBound(a) * 2, 1 To 5)
  
  ant = a(2, 1)
  For i = 2 To UBound(a)
    If ant <> a(i, 1) Then
      n = 0
      k = k + 1
      b(k, 2) = "TOTAL"
      b(k, 5) = tot
      tot = 0
      If i = UBound(a) Then Exit For
    End If
    n = n + 1
    k = k + 1
    b(k, 1) = n
    b(k, 2) = a(i, 1)
    b(k, 3) = a(i, 2)
    b(k, 4) = a(i, 3)
    b(k, 5) = a(i, 6)
    tot = tot + a(i, 6)
    ant = a(i, 1)
  Next
  
  'FORMAT CELLS
  With Sheets("DATE")
    .Range("A2:E" & Rows.Count).Clear
    .Range("A2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
    .Range("A:E").HorizontalAlignment = xlCenter
    .Range("B:B").NumberFormat = "dd/mm/yyyy"
    .Range("E:E").NumberFormat = "#,##0.00"
    .Range("A2", .Range("E" & Rows.Count).End(3)).Borders.LineStyle = xlContinuous
  End With
End Sub

 

[Alaa mg]

thanks Kevin for the code
I notice your code is slow .I expect you don't notice this

macro for 8000 rows

 

[Alaa mg]

Great !
this is acceptable about speed .
many thanks ,Dante.