Sum, Merge, Delete Duplicate Rows -- HELP!!

[HERALDOS]

Do I need to use a macro to do the following?

I have a large spreadsheet that I need to merge the cells with the same product number, total the qty sold and delete the duplicates. Below is a sample of the data ... How will I make this work without have to sort and manually total the items and then delete. Here is a sample of the data.
Product # Desc Wholesale # QTY
943005 SCISSORS,FSK,STR,BR-CNR,8",PNK 01-005792 1
943005 SCISSORS,FSK,STR,BR-CNR,8",PNK 01-005792 1
943005 SCISSORS,FSK,STR,BR-CNR,8",PNK 01-005792 3
576481 TAPE,CORRECTION,2PK,WHITE 01005 4
576481 TAPE,CORRECTION,2PK,WHITE 01005 6
576481 TAPE,CORRECTION,2PK,WHITE 01005 8
576481 TAPE,CORRECTION,2PK,WHITE 01005 21
576481 TAPE,CORRECTION,2PK,WHITE 01005 12

 

[pboltonchina]

Assuming duplicate data in Column A, try this

Sub MergeItems()
'Jerry Beaucaire  3/11/2010    (updated 6/21/2010)
'Merge all QTY columns for same items
Dim LastRow As Long, Rw As Long
Dim LastCol As Long, Col As Long
Dim DelRNG As Range
Application.ScreenUpdating = False

LastRow = Range("A" & Rows.Count).End(xlUp).Row
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column

Set DelRNG = Range("A" & LastRow + 10)

For Rw = 2 To LastRow
    If Application.WorksheetFunction.CountIf(Range("A2:A" & Rw), _
        Range("A" & Rw)) > 1 Then
            Set DelRNG = Union(DelRNG, Range("A" & Rw))
    Else
        For Col = 2 To LastCol
            Cells(Rw, Col) = Application.WorksheetFunction.SumIf(Range("A:A"), _
                Range("A" & Rw), Columns(Col))
        Next Col
    End If
Next Rw

DelRNG.EntireRow.Delete xlShiftUp
Set DelRNG = Nothing
Application.ScreenUpdating = True
End Sub

 

[HERALDOS]

Thanks, I'll try that although I don't have a clue about how to use macros. I'll learn something new today.

 

[Leith Ross]

Hello HERALDOS,

Here is another way to do it. I have added a link to an example workbook you can download. The workbook has button on the worksheet to run the macro.

Click here to download the workbook

' Thread:  http://www.mrexcel.com/forum/showthread.php?t=577283
' Poster:  HERALDOS
' Written: September 07, 2011
' Author:  Leith Ross

Sub ConsolidateProducts()

  Dim Cell As Range
  Dim Dict As Object
  Dim ProductNumber As Variant
  Dim ProductNumbers As Variant
  Dim Quantity As Double
  Dim Rng As Range
  Dim RngEnd As Range
  Dim Wks As Worksheet
  
    Set Wks = Worksheets("Sheet1")
    
      Set Rng = Wks.Range("A1").CurrentRegion
      Set Rng = Rng.Offset(1, 0).Resize(RowSize:=Rng.Rows.Count - 1)
      
      Set ProductNumbers = CreateObject("Scripting.Dictionary")
      ProductNumbers.CompareMode = vbTextCompare
      
        For Each Cell In Rng.Columns(1).Cells
          ProductNumber = Trim(Cell.Value)
          Quantity = Cell.Offset(0, 3).Value
          If ProductNumber <> "" Then
            If Not ProductNumbers.Exists(ProductNumber) Then
               ProductNumbers.Add ProductNumber, Quantity
            Else
               ProductNumbers(ProductNumber) = ProductNumbers(ProductNumber) + Quantity
               Cell.EntireRow.ClearContents
            End If
          End If
        Next Cell
        
      Rng.Sort Key1:=Rng.Cells(1, 1), Order1:=xlAscending, Header:=xlYes, _
               MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers
                 
      If ProductNumbers.Count = 0 Then Exit Sub
      Set Rng = Wks.Range("D2").Resize(ProductNumbers.Count, 1)
      
      Rng.Value = WorksheetFunction.Transpose(ProductNumbers.Items)
      
End Sub

 

[HERALDOS]

Leith, that almost worked!! It didn't sum the totals of all the like product numbers. Any suggestions on how to fix that?