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

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
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
325
Peter_SSs
Peter_SSs
A
  • Solved
populate summary sheet by merge amounts based on two columns(ID,CUSTOMER)
Replies
3
Views
203
DanteAmor
DanteAmor
O
  • Solved
Put amount in DEBIT,CREDIT columns based on matching part of item
Replies
9
Views
186
Omran Y
O
C
  • Question Question
Count distinct values in column X based on unique value in col Y
Replies
3
Views
425
JvdV
J
C
  • Question Question
Counting Unique if theres a value in another field
2
Replies
10
Views
792
Marcelo Branco
M

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

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