VBA modification

[231tony231]

Hi,
i'm quite a beginner with VBA and i found a code that almost does what i need. Basicly i need to find the duplicate in colum "A", sum the Qty of the duplicate with are in colum "B" and i would like to be able to copy some or the remaining colum without summing them since they are description.

Here is the actual code:

[FONT=Courier New]       
  Dim Cell As Range
  Dim Data() As Variant
  Dim DSO As Object
  Dim DSO_c As Object                                   '
  Dim Key As Variant
  Dim Keys As Variant
  Dim I As Long
  Dim Item As Variant
  Dim Item_c As Variant                                 '
  Dim Items As Variant
  Dim Items_c 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") = "Investment"
             Cells(1, "B") = "Total Amount"
             Cells(1, "C") = "Total Amount"             '
             Rows(1).Font.Bold = True
             Columns("A:C").AutoFit
        End If
    On Error GoTo 0
    
    Set DSO = CreateObject("Scripting.Dictionary")
    Set DSO_c = CreateObject("Scripting.Dictionary")    '
    DSO.CompareMode = vbTextCompare
    DSO_c.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
               Item_c = Cell.Offset(0, 2).Value         '
               If Key <> "" Then
                 If Not DSO.Exists(Key) Then
                    DSO.Add Key, Item
                    DSO_c.Add Key, Item_c               '
                 Else
                    DSO(Key) = DSO(Key) + Item
                    DSO_c(Key) = DSO_c(Key) + Item_c      '
                 End If
               End If
             Next Cell
        End If
      Next Wks
      
      With SumWks
        .UsedRange.Offset(1, 0).ClearContents
        Keys = DSO.Keys
        Items = DSO.Items
        Items_c = DSO_c.Items                           '
          For I = 0 To DSO.Count - 1
            .Cells(I + 2, "A") = Keys(I)
            .Cells(I + 2, "B") = Items(I)
            .Cells(I + 2, "C") = Items_c(I)             '
          Next I
        .UsedRange.Sort Key1:=.Cells(2, 1), Order1:=xlAscending, _
                        Header:=xlYes, Orientation:=xlSortColumns
      End With
    
    Set DSO = Nothing
  Set DSO_c = Nothing                                 '
    
End Sub[/FONT]

thx in advance !!!</PRE>