Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

merging duplicated items with values

0

hi

I  try  merging  duplicated items  based on COL A   and  summing  the  values  . so  far  the  code  doesn't  work   .  I  need  help  from experts  check  the  code  and  guide  me   how  correct my  mistake .  I  attached file contains   a simple  data  , but  my  real  data are at least 2000 rows  that's  why  I  would  do  that  by  vba  . I  put  expected  result  in  COL F,G .

Sub summing_duplicateditems()
  Dim R As Long, Data As Variant, Uniques
  Data = Range("A2", Cells(Rows.Count, "D").End(xlUp))
  With CreateObject("Scripting.Dictionary")
    For R = 1 To UBound(Data)
      .Item(Data(R, 1)) = Application.Max(.Item(Data(R, 1)), Data(R, 4))
    Next
    Range("F2:F" & .Count) = Application.Transpose(.Keys)
    Range("G2:G" & .Count) = Application.Transpose(.Items)
  End With
End Sub

thanks in advance 

Answer
Discuss

Discussion

Leopard

It's not clear what you're trying to do here- your sample worksheet seems to show that you want to sum vlaues of the same type but the ttile of your macro (GetUniquesByLatestDate) implies that you just want to display the latest dated record (but your sample data has no dates).

Please edit your question to clarify.
John_Ru (rep: 6092) Aug 28, '21 at 4:56 am
John
sorry  about  title of  the  macro  makes  confused  for  you
your sample worksheet seems to show that you want to sum values of the same type
yes   this  is  what   I want .
leopard (rep: 88) Aug 28, '21 at 5:18 am
Add to Discussion

Answers

0
Selected Answer

Leopard

Suggest you try this approach- it sees if there's an existing dictionary item, adding one if not and adding the quantities if so. Note that I've delcared a dictionary called QtyDict to collect quantities (which also means you can track its growth if you step through the code in VB Explorer).

Comments should help you, other pointers/changes are in bold:

Option Base 1
Sub summing_duplicateditems()

Dim Data As Variant, R As Long
Dim QtyDict As Object

Set QtyDict = CreateObject("scripting.dictionary")

Data = Range("A2", Cells(Rows.Count, "D").End(xlUp))

With QtyDict

    For R = 1 To UBound(Data)

        If Not .Exists(Data(R, 1)) Then 'if no dictionary entry for first column then make a new key...
            .Add Data(R, 1), Data(R, 4) 'adding first value

            Else
                .Item(Data(R, 1)) = .Item(Data(R, 1)) + Data(R, 4) ' if existing dictionary, add new value for that item
        End If

    Next R

        Range("F2:F" & .Count + 1) = Application.Transpose(.Keys) ' added 1 to each count (since reporting totals from row 2)
        Range("G2:G" & .Count + 1) = Application.Transpose(.Items)

End With

End Sub
Note that this assumes you want to add values in column 4 (and they're all numeric) based on ONLY what's in column 1 and that you have headings like "Code" and "Total Qty" already in cells F1:G1. I leave you to arrange that (and any deletion of previous runs of the macro) plus locking it down to run on sheet1.

Hope this helps.

Discuss

Discussion

john 
thanks  for  your  support me .
leopard (rep: 88) Aug 28, '21 at 5:45 pm
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login