add formulas in last column after sorting for each duplicates ID

A

Ali M

Active Member
Joined
Oct 10, 2021
Messages
348
Office Version
  1. 2019
  2. 2013
Platform
  1. Windows
Hello,

I need add two formulas for duplicates in BALANCE column based on duplicates ID in column K for each date in column A .

so first should put duplicated id in column K under each other of them based on arranged as write , not sort from A-Z just keep the data as arranged in original data and the only thing put the duplicates ID under each other of them without change in sorting after that should add two formulas for each duplicates ID for each date.
You will note there are different formulas for first ,next rows for each duplicated ID for each date.
every time will change data before TOTAL row so should n't problem to sort every time.
maybe need sorting data for about 10000 rows in the future.
Ali-M.xlsm
IJKLMN
1DATEDETAILSSAFESDEBITCREDITBALANCE
220/03/2024SALES INVOICEBANK3,100.003,100.00
320/03/2024SALES INVOICESHOP SAFE4,800.007,900.00
420/03/2024SALES INVOICEHOME SAFE4,200.0012,100.00
520/03/2024RECEIVED CASHBANK3,000.0015,100.00
620/03/2024PAID CASHSHOP SAFE4,400.0010,700.00
720/03/2024PAID CASHHOME SAFE2,700.008,000.00
821/03/2024SALES INVOICESHOP SAFE1,000.001,000.00
921/03/2024SALES INVOICEHOME SAFE1,200.002,200.00
1021/03/2024PAID CASHSHOP SAFE2,200.000.00
1121/03/2024RECEIVED CASHHOME SAFE10,000.001,100.008,900.00
1222/03/2024RECEIVED CASHBANK3,000.003,000.00
1323/03/2024RECEIVED CASHHOME SAFE2,000.002,000.00
1423/03/2024RECEIVED CASHBANK5,000.007,000.00
1523/03/2024PAID CASHSHOP SAFE3,000.0010,000.00
16TOTAL40,300.0010,400.0029,900.00
ASZ
Cell Formulas
RangeFormula
L16:M16L16=SUM(L2:L15)



result


Ali-M.xlsm
IJKLMN
1DATEDETAILSSAFESDEBITCREDITBALANCE
220/03/2024SALES INVOICEBANK3,100.003,100.00
320/03/2024RECEIVED CASHBANK3,000.006,100.00
420/03/2024SALES INVOICESHOP SAFE4,800.004,800.00
520/03/2024PAID CASHSHOP SAFE4,400.00400.00
620/03/2024SALES INVOICEHOME SAFE4,200.004,200.00
720/03/2024PAID CASHHOME SAFE2,700.001,500.00
821/03/2024SALES INVOICESHOP SAFE1,000.001,000.00
921/03/2024PAID CASHSHOP SAFE2,200.00-1200.00
1021/03/2024SALES INVOICEHOME SAFE1,200.001,200.00
1121/03/2024RECEIVED CASHHOME SAFE10,000.001,100.0010,100.00
1222/03/2024RECEIVED CASHBANK3,000.003,000.00
1323/03/2024RECEIVED CASHHOME SAFE2,000.002,000.00
1423/03/2024RECEIVED CASHBANK5,000.005,000.00
1523/03/2024PAID CASHSHOP SAFE3,000.003,000.00
16TOTAL40,300.0010,400.0029,900.00
RESULT
Cell Formulas
RangeFormula
N2,N12:N16,N10,N8,N6,N4N2=L2-M2
N3,N11,N9,N7,N5N3=N2+L3-M3
L16:M16L16=SUM(L2:L15)
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Sort by date Sort by votes
Ali M said:
not sort from A-Z just keep the data as arranged in original data
Click to expand...
A special order is required. To do this I need some columns available in your sheet, let's say from cell AD2 onwards. Ultimately this data will be deleted.

According to OP, the data starts in cell I2 and goes to cell N and the last row with data. And I can also appreciate that your original data is sorted by date.

Try:

VBA Code: 
Sub Sort_And_Formulas()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, idx As Long, y As Long
  Dim dic As Object
  Dim ky As String, ant As String
  Dim bal As Double
  
  Application.ScreenUpdating = False
  Set dic = CreateObject("Scripting.Dictionary")
  
  a = Range("I2:N" & Range("I" & Rows.Count).End(3).Row - 1)
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2) + 1)
  
  For i = 1 To UBound(a)
    k = k + 1
    For j = 1 To UBound(a, 2)
      b(k, j) = a(i, j)
    Next
    ky = a(i, 1) & "|" & a(i, 3)
    If Not dic.exists(ky) Then dic(ky) = dic.Count + 1
    b(k, 7) = dic(ky)
  Next
  
  With Range("AD2").Resize(UBound(b, 1), UBound(b, 2))
    .Value = b
    .Sort .Cells(1), xlAscending, .Cells(1).Offset(0, 6), , xlAscending, Header:=xlNo
    
    a = .Value
    For i = 1 To UBound(a)
      ky = a(i, 1) & "|" & a(i, 3)
      If ky = ant Then bal = a(i - 1, 6) Else bal = 0
      a(i, 6) = bal + a(i, 4) - a(i, 5)
      ant = ky
    Next
    
    Range("I2").Resize(UBound(a, 1), UBound(a, 2) - 1).Value = a
    .ClearContents
  End With
  
  Application.ScreenUpdating = True
End Sub

🤗
 
Upvote 0
Awesome!:)
may you specify sheets ,please?
I don't want to sort for the same sheet .
 
Upvote 0
Here is another option that you could consider. It is a similar to @DanteAmor's approach but does not require any helper columns. It also applies formulas to column N as you requested, rather than values. The formulas are different to yours though as I have used the same formula for the whole column - but it produces the same results as yours. If you prefer the values instead of formulas then there would be just one more line of code to add immediately above the "End With" line of code near the end and that line would be: .Value = .Value
I have assumed that the 'RESULT' sheet already exists and that if there is already any data in columns I:N that data can be removed.
Also, like Dante, I have assumed that the original data is sorted by date like your sample data.

VBA Code: 
Sub Rearrange()
  Dim d As Object
  Dim a As Variant
  Dim i As Long
  Dim s As String
 
  Set d = CreateObject("Scripting.Dictionary")
  Application.ScreenUpdating = False
  a = Sheets("ASZ").Range("I1", Sheets("ASZ").Range("N" & Rows.Count).End(xlUp)).Value
  For i = 2 To UBound(a)
    s = a(i, 1) & "|" & a(i, 3)
    If Not d.exists(s) Then d(s) = d.Count + 1
    a(i, 6) = d(s)
  Next i
  With Sheets("RESULT").Range("I1:N1").Resize(UBound(a))
    .EntireColumn.ClearContents
    .Value = a
    .Sort Key1:=.Columns(6), Order1:=xlAscending, Header:=xlYes
    .Columns(6).Offset(1).Resize(UBound(a) - 1).FormulaR1C1 = "=RC[-2]-RC[-1]+N(R[-1]C)*(RC[-5]=R[-1]C[-5])*(RC[-3]=R[-1]C[-3])"
    .Cells(UBound(a), 4).Resize(, 2).FormulaR1C1 = "=SUM(R2C:R[-1]C)"
  End With
  Application.ScreenUpdating = True
End Sub

Here is my 'RESULT' sheet after running the above code.

Ali M.xlsm
IJKLMN
1DATEDETAILSSAFESDEBITCREDITBALANCE
220/03/2024SALES INVOICEBANK3,100.003,100.00
320/03/2024RECEIVED CASHBANK3,000.006,100.00
420/03/2024SALES INVOICESHOP SAFE4,800.004,800.00
520/03/2024PAID CASHSHOP SAFE4,400.00400.00
620/03/2024SALES INVOICEHOME SAFE4,200.004,200.00
720/03/2024PAID CASHHOME SAFE2,700.001,500.00
821/03/2024SALES INVOICESHOP SAFE1,000.001,000.00
921/03/2024PAID CASHSHOP SAFE2,200.00-1,200.00
1021/03/2024SALES INVOICEHOME SAFE1,200.001,200.00
1121/03/2024RECEIVED CASHHOME SAFE10,000.001,100.0010,100.00
1222/03/2024RECEIVED CASHBANK3,000.003,000.00
1323/03/2024RECEIVED CASHHOME SAFE2,000.002,000.00
1423/03/2024RECEIVED CASHBANK5,000.005,000.00
1523/03/2024PAID CASHSHOP SAFE3,000.003,000.00
16TOTAL40,300.0010,400.0029,900.00
RESULT
Cell Formulas
RangeFormula
N2:N16N2=L2-M2+N(N1)*(I2=I1)*(K2=K1)
L16:M16L16=SUM(L$2:L15)
 
Last edited:
Upvote 0
Ali M said:
may you specify sheets ,please?
Click to expand...
Apparently I didn't realize they were different sheets.

Here is the macro with the changes to put the result in the result sheet:
VBA Code: 
Sub Sort_And_Formulas()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  Dim dic As Object
  Dim ky As String, ant As String
  Dim bal As Double
  Dim shR As Worksheet
  
  Application.ScreenUpdating = False
  Set dic = CreateObject("Scripting.Dictionary")
  Set shR = Sheets("RESULT")
  
  Sheets("ASZ").Range("I:N").Copy shR.Range("I1")
  a = shR.Range("I2:N" & shR.Range("I" & Rows.Count).End(3).Row - 1)
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2) + 1)
  
  For i = 1 To UBound(a)
    k = k + 1
    For j = 1 To UBound(a, 2)
      b(k, j) = a(i, j)
    Next
    ky = a(i, 1) & "|" & a(i, 3)
    If Not dic.exists(ky) Then dic(ky) = dic.Count + 1
    b(k, 7) = dic(ky)
  Next
  
  With shR.Range("AD2").Resize(UBound(b, 1), UBound(b, 2))
    .Value = b
    .Sort .Cells(1), xlAscending, .Cells(1).Offset(0, 6), , xlAscending, Header:=xlNo
    
    a = .Value
    For i = 1 To UBound(a)
      ky = a(i, 1) & "|" & a(i, 3)
      If ky = ant Then bal = a(i - 1, 6) Else bal = 0
      a(i, 6) = bal + a(i, 4) - a(i, 5)
      ant = ky
    Next
    
    shR.Range("I2").Resize(UBound(a, 1), UBound(a, 2) - 1).Value = a
    .ClearContents
  End With
  
  Application.ScreenUpdating = True
End Sub

😇
 
Upvote 0
Solution
Hi peter ,
your code is really nice, but unfortunately will delete formatting and borders , colors for headers and last row .
 
Upvote 0
Ali M said:
but unfortunately will delete formatting and borders , colors for headers and last row .
Click to expand...
Sorry, there wasn't any specific mention of that in your requirements so I didn't know to allow. :)
It also seems that you don't want formulas in the BALANCE column so I have also allowed for that
My no helper columns equivalent is:

VBA Code: 
Sub Rearrange_v2()
  Dim d As Object
  Dim a As Variant
  Dim i As Long
  Dim s As String
 
  Set d = CreateObject("Scripting.Dictionary")
  Application.ScreenUpdating = False
  Sheets("ASZ").Columns("I:N").Copy Destination:=Sheets("RESULT").Range("I1")
  With Sheets("RESULT").Range("I1:N" & Sheets("Result").Range("J" & Rows.Count).End(xlUp).Row)
    a = .Value
    For i = 2 To UBound(a)
      s = a(i, 1) & "|" & a(i, 3)
      If Not d.exists(s) Then d(s) = d.Count + 1
      a(i, 6) = d(s)
    Next i
    .Value = a
    .Sort Key1:=.Columns(6), Order1:=xlAscending, Header:=xlYes
    .Columns(6).Offset(1).FormulaR1C1 = "=RC[-2]-RC[-1]+N(R[-1]C)*(RC[-5]=R[-1]C[-5])*(RC[-3]=R[-1]C[-3])"
    .Columns(6).Offset(1).Value = .Columns(6).Offset(1).Value
  End With
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
Thanks Peter .
your code also is really excellent.:)
 
Upvote 0
You must log in or register to reply here.

Similar threads

O
  • Solved
Find and match header in different location for the column based on sheet name
Replies
8
Views
140
Omar M
O
A
  • Solved
Extract last amounts in column within two dates
Replies
7
Views
112
Peter_SSs
Peter_SSs
A
  • Solved
Extract duplicates dates and insert TOTAL row for each duplicates dates
Replies
4
Views
132
Alaa mg
A
H
  • Solved
Getting the last price for each duplicates ID
Replies
2
Views
143
Hasson
H
H
  • Solved
populate dynamic list in dropdown without duplicates items based on sheet name
Replies
3
Views
319
kevin9999
K

Forum statistics

Threads
1,224,900
Messages
6,181,631
Members
453,059
Latest member
jkevin

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top