Hi,
I have a spreadsheet with 2 columns in it. One contains a UPC code the other contains a qty, ex:

UPC Qty
093524100011 1

I need to count and sum the number of duplicates in the UPC Column, ex:

UPC QTY
093524100011 1
093524100011 1
093524100011 1
093524100011 1
093524100023 6
093524100023 1
093524100023 1
093524100023 1

So I have:
UPC Qty
093524100011 4
093524100023 9


I actually found a macro in a post in here that works great but in the report it returns it strips out the leading 0 in the upc code:

http://www.excelforum.com/excel-prog...o-formula.html

Sub CreateSummaryReport()

  Dim Cell As Range
  Dim Data() As Variant
  Dim DSO As Object
  Dim Key As Variant
  Dim Keys As Variant
  Dim I As Long
  Dim Item As Variant
  Dim Items As Variant
  Dim Rng As Range
  Dim RngEnd As Range
  Dim SumWks As Worksheet
  Dim Wks As Worksheet
  
    On Error Resume Next
      Set SumWks = Worksheets("Summary Report")
        If Err = 9 Then
           Err.Clear
           Worksheets.Add.Name = "Summary Report"
           Set SumWks = ActiveSheet
             Cells(1, "A") = "Model Number"
             Cells(1, "B") = "Quantity"
             Rows(1).Font.Bold = True
             Columns("A:B").AutoFit
        End If
    On Error GoTo 0
    
    Set DSO = CreateObject("Scripting.Dictionary")
    DSO.CompareMode = vbTextCompare
    
      For Each Wks In Worksheets
        If Wks.Name <> SumWks.Name Then
           Set Rng = Wks.Range("A1")
           Set RngEnd = Rng.Cells(Rows.Count, Rng.Column).End(xlUp)
           Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, Wks.Range(Rng, RngEnd))
             For Each Cell In Rng
               Key = Trim(Cell.Value)
               Item = Cell.Offset(0, 1).Value
               If Key <> "" Then
                 If Not DSO.Exists(Key) Then
                    DSO.Add Key, Item
                 Else
                    DSO(Key) = DSO(Key) + Item
                 End If
               End If
             Next Cell
        End If
      Next Wks
      
      With SumWks
        .UsedRange.Offset(1, 0).ClearContents
        Keys = DSO.Keys
        Items = DSO.Items
          For I = 0 To DSO.Count - 1
            .Cells(I + 2, "A") = Keys(I)
            .Cells(I + 2, "B") = Items(I)
          Next I
        .UsedRange.Sort Key1:=.Cells(2, 1), Order1:=xlAscending, _
                        Header:=xlYes, Orientation:=xlSortColumns
      End With
    
    Set DSO = Nothing
    
End Sub
This works great because I need the report returned in another sheet because I then run a script to append data from one sheet to another. Is there anyway to modify this script to leave the leading 0 alone ion the report? I have to go in and format the UPC column to text before I scan data into it and that takes care of it there but the report still strips off the leading Zero's

Thanks for any help!