LinkBack URL
About LinkBacks
rizmomin 
Hello:
Please refer to attached file.
I need VB code to find unique names from Column A and Paste at cell G7 and add corresponding total from cell H7 down.
Let me know if you have any questions.G
Thanks.
Riz
Hello:
Please refer to attached file.
I need VB code to find unique names from Column A and Paste at cell G7 and add corresponding total from cell H7 down.
Let me know if you have any questions.G
Thanks.
Riz
It can be done with a formula - does it have to be VBA?
Ali
Enthusiastic self-taught user of MS Excel who's always learning!
Don't forget to say "thank you" in your thread to anyone who has offered you help. It's a universal courtesy.
You can reward them by clicking on * Add Reputation below their user name on the left, if you wish.
NB: as a Moderator, I never accept friendship requests.
Forum Rules (updated August 2023): please read them here.
Try this:-
Regards Mick
Sub MG23Aug13 Dim Rng As Range, Dn As Range, n As Long Set Rng = Range(Range("A7"), Range("A" & Rows.Count).End(xlUp)) With CreateObject("scripting.dictionary") .CompareMode = vbTextCompare For Each Dn In Rng If Not .Exists(Dn.Value) Then .Add Dn.Value, Dn.Offset(, 2).Value Else .Item(Dn.Value) = .Item(Dn.Value) + Dn.Offset(, 2).Value End If Next Range("G7").Resize(.Count, 2) = Application.Transpose(Array(.Keys, .items)) End With End Sub
Try this code
Sub Test() Dim dic As Object Dim v As Variant Dim s As Variant Dim i As Long Set dic = CreateObject("scripting.dictionary") v = Range("A7:C" & Cells(Rows.Count, 1).End(xlUp).Row).Value For i = 1 To UBound(v) s = v(i, 1) If Not dic.exists(s) Then dic(s) = Array(, 0) dic(s) = Array(v(i, 1), dic(s)(1) + v(i, 3)) Next i With Range("G7") .Resize(dic.Count, 2).Value = Application.Transpose(Application.Transpose(dic.items)) End With End Sub
< ----- Please click the little star * next to add reputation if my post helps you
Visit Forum : From Here
There are currently 1 users browsing this thread. (0 members and 1 guests)
Posting Permissions
Register To Reply
Bookmarks