Add a new row based on Unique value and delete old

C

Chandresh

Board Regular
Joined
Jul 21, 2009
Messages
146
Hi All,

First time I am coming to this situation were I don't have any idea how to write a macro for below situation.

1) Unique id is in Column B.
2) Amount is in column C.
3) date of transaction is in column A

I need a macro which will add the amount based on unique ID and create new rows which will have the following and delete old rows.
- last date in date column
- ID in particulars column
- amount in amount column.

[TABLE="width: 330"]
<colgroup><col><col><col><col></colgroup><tbody>[TR]
[TD]Date[/TD]
[TD]Particulars[/TD]
[TD]Amount[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]23-Jul-18[/TD]
[TD]ABC[/TD]
[TD] -3,36,000 [/TD]
[TD][/TD]
[/TR]
[TR]
[TD]24-Jul-18[/TD]
[TD]ABC[/TD]
[TD] 78,000 [/TD]
[TD][/TD]
[/TR]
[TR]
[TD]25-Jul-18[/TD]
[TD]ABC[/TD]
[TD] 48,000 [/TD]
[TD][/TD]
[/TR]
[TR]
[TD]26-Jul-18[/TD]
[TD]ABC[/TD]
[TD] 54,000 [/TD]
[TD] -1,56,000 [/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]23-Jul-18[/TD]
[TD]XYZ[/TD]
[TD] -3,36,000 [/TD]
[TD][/TD]
[/TR]
[TR]
[TD]24-Jul-18[/TD]
[TD]XYZ[/TD]
[TD] 2,27,800 [/TD]
[TD][/TD]
[/TR]
[TR]
[TD]25-Jul-18[/TD]
[TD]XYZ[/TD]
[TD] 98,000 [/TD]
[TD][/TD]
[/TR]
[TR]
[TD]25-Jul-18[/TD]
[TD]XYZ[/TD]
[TD] 1,000 [/TD]
[TD][/TD]
[/TR]
[TR]
[TD]26-Jul-18[/TD]
[TD]XYZ[/TD]
[TD] 54,000 [/TD]
[TD] 44,800 [/TD]
[/TR]
</tbody>[/TABLE]

my output should be as shown below:

[TABLE="width: 262"]
<colgroup><col><col><col></colgroup><tbody>[TR]
[TD]Date[/TD]
[TD]Particulars[/TD]
[TD]Amount[/TD]
[/TR]
[TR]
[TD]26-Jul-18[/TD]
[TD]ABC[/TD]
[TD="align: right"]-156000[/TD]
[/TR]
[TR]
[TD]26-Jul-18[/TD]
[TD]XYZ[/TD]
[TD="align: right"]44800[/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Sort by date Sort by votes
How about
Code: 
Sub SumDupes()
   Dim Cl As Range
   Dim Tmp1 As Variant, Tmp2 As Variant
   Dim Itm As Variant
   Dim i As Long
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("B2", Range("B" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            .Add Cl.Value, Array(Cl.Offset(, -1).Value, Cl.Value, Cl.Offset(, 1).Value)
         Else
            Tmp2 = .Item(Cl.Value)(2) + Cl.Offset(, 1).Value
            If .Item(Cl.Value)(0) < Cl.Offset(, -1).Value Then Tmp1 = Cl.Offset(, -1).Value Else Tmp1 = .Item(Cl.Value)(0)
            .Item(Cl.Value) = Array(Tmp1, Cl.Value, Tmp2)
         End If
      Next Cl
      Range("A1").CurrentRegion.Offset(1).ClearContents
      i = 1
      For Each Itm In .items
         i = i + 1
         Range("A" & i).Resize(, 3).Value = Itm
      Next Itm
   End With
End Sub
 
Upvote 0
My data columns have increased I have edited the code however I am not getting the output in correct column...
- product id coming in column2(it should come (below product)
- Quantity coming in column3(it should come (below Quantity)

[TABLE="width: 1817"]
<colgroup><col><col><col><col><col><col><col><col span="2"><col><col><col><col><col></colgroup><tbody>[TR]
[TD]Output[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Transaction Date[/TD]
[TD]Column2[/TD]
[TD]Column3[/TD]
[TD]Product[/TD]
[TD]Column5[/TD]
[TD]Column6[/TD]
[TD]Column7[/TD]
[TD]Column8[/TD]
[TD]Column9[/TD]
[TD]Column10[/TD]
[TD]Column11[/TD]
[TD]Column12[/TD]
[TD]Quantity[/TD]
[TD]Column14[/TD]
[/TR]
[TR]
[TD="align: right"]26-Jul-18[/TD]
[TD]ABC[/TD]
[TD="align: right"]-156000[/TD]
[TD="align: center"]#N/A[/TD]
[TD="align: center"]#N/A[/TD]
[TD="align: center"]#N/A[/TD]
[TD="align: center"]#N/A[/TD]
[TD="align: center"]#N/A[/TD]
[TD="align: center"]#N/A[/TD]
[TD="align: center"]#N/A[/TD]
[TD="align: center"]#N/A[/TD]
[TD="align: center"]#N/A[/TD]
[TD="align: center"]#N/A[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]26-Jul-18[/TD]
[TD]XYZ[/TD]
[TD="align: right"]159300[/TD]
[TD="align: center"]#N/A[/TD]
[TD="align: center"]#N/A[/TD]
[TD="align: center"]#N/A[/TD]
[TD="align: center"]#N/A[/TD]
[TD="align: center"]#N/A[/TD]
[TD="align: center"]#N/A[/TD]
[TD="align: center"]#N/A[/TD]
[TD="align: center"]#N/A[/TD]
[TD="align: center"]#N/A[/TD]
[TD="align: center"]#N/A[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]New Data[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Transaction Date[/TD]
[TD]Column2[/TD]
[TD]Column3[/TD]
[TD]Product[/TD]
[TD]Column5[/TD]
[TD]Column6[/TD]
[TD]Column7[/TD]
[TD]Column8[/TD]
[TD]Column9[/TD]
[TD]Column10[/TD]
[TD]Column11[/TD]
[TD]Column12[/TD]
[TD]Quantity[/TD]
[TD]Column14[/TD]
[/TR]
[TR]
[TD="align: right"]23-Jul-18[/TD]
[TD][/TD]
[TD][/TD]
[TD]ABC[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]-336000[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]24-Jul-18[/TD]
[TD][/TD]
[TD][/TD]
[TD]ABC[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]78000[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]25-Jul-18[/TD]
[TD][/TD]
[TD][/TD]
[TD]ABC[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]48000[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]26-Jul-18[/TD]
[TD][/TD]
[TD][/TD]
[TD]ABC[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]54000[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]23-Jul-18[/TD]
[TD][/TD]
[TD][/TD]
[TD]XYZ[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]-10800[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]24-Jul-18[/TD]
[TD][/TD]
[TD][/TD]
[TD]XYZ[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]62100[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]25-Jul-18[/TD]
[TD][/TD]
[TD][/TD]
[TD]XYZ[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]36000[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]26-Jul-18[/TD]
[TD][/TD]
[TD][/TD]
[TD]XYZ[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: right"]72000[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

code :
Sub SumDupes()
Dim Cl As Range
Dim Tmp1 As Variant, Tmp2 As Variant
Dim Itm As Variant
Dim i As Long
Sheets("Partly Unrealised").Select
With CreateObject("scripting.dictionary")
For Each Cl In Range("d2", Range("d" & Rows.Count).End(xlUp))
If Not .exists(Cl.Value) Then
.Add Cl.Value, Array(Cl.Offset(, -3).Value, Cl.Value, Cl.Offset(, 9).Value)
Else
Tmp2 = .Item(Cl.Value)(2) + Cl.Offset(, 9).Value
If .Item(Cl.Value)(0) < Cl.Offset(, -3).Value Then Tmp1 = Cl.Offset(, -3).Value Else Tmp1 = .Item(Cl.Value)(0)
.Item(Cl.Value) = Array(Tmp1, Cl.Value, Tmp2)
End If
Next Cl
Range("A1").CurrentRegion.Offset(1).ClearContents
i = 1
For Each Itm In .items
i = i + 1
Range("A" & i).Resize(, 13).Value = Itm
Next Itm
End With
End Sub


- could you please help

Thanks
Chandresh
 
Upvote 0
You just need to change the last part to
Code: 
   For Each Itm In .items
      i = i + 1
      Range("D" & i).Value = Itm(1)
      Range("A" & i).Value = Itm(0)
      Range("M" & i).Value = Itm(2)
   Next Itm
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Locked
  • Question Question
Add new row by looping column (Scripting Dictionary)
Replies
5
Views
327
Peter_SSs
Peter_SSs
A
  • Solved
populate summary sheet by merge amounts based on two columns(ID,CUSTOMER)
Replies
3
Views
212
DanteAmor
DanteAmor
O
  • Solved
Put amount in DEBIT,CREDIT columns based on matching part of item
Replies
9
Views
207
Omran Y
O
C
  • Question Question
Count distinct values in column X based on unique value in col Y
Replies
3
Views
433
JvdV
J
C
  • Question Question
Counting Unique if theres a value in another field
2
Replies
10
Views
802
Marcelo Branco
M

Forum statistics

Threads
1,224,823
Messages
6,181,175
Members
453,021
Latest member
Justyna P

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