Vba Macro for remove duplicate values and sum other column

[Ghoghnuse]

Hi

I have a table like this :

	A	B	C	D	E	F	G
16	CODE						AMOUNT
17	202						100
18	203						200
19	202						200
20	205						300
21	203						500
22	208						150
23	203						100
24	205						500

<tbody>
</tbody>

I Want a macro to remove Duplicate Codes and calculate sum of each codes and copy results to new sheet .

Like This :

Code	Sum of Amounts
202	300
203	800
205	800
208	150

<tbody>
</tbody>

I know that i could use Pivot Table but i want to use macro .

Thanks in Advance .

 

[Fluff]

How about

Sub RemoveDupe_sum()


    Dim Cl As Range
    Dim Cnt As Long
    
    With CreateObject("scripting.dictionary")
        For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
            If Not .exists(Cl.Value) Then
                .Add Cl.Value, Cl.Offset(, 6).Value
            Else
                .Item(Cl.Value) = .Item(Cl.Value) + Cl.Offset(, 6).Value
            End If
        Next Cl
        Sheets("Sheet1").Range("A1").Resize(.Count).Value = Application.Transpose(.Keys)
        Sheets("Sheet1").Range("B1").Resize(.Count).Value = Application.Transpose(.items)
        End With

End Sub

 

[Ghoghnuse]

Thanks a lot Fluff ! Work like a charm ...

But how could i copy result to first blank cell end of column A in sheet1 ?

 

[Fluff]

Use

Sub RemoveDupe_sum()


    Dim Cl As Range
    Dim Cnt As Long
    
    With CreateObject("scripting.dictionary")
        For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
            If Not .exists(Cl.Value) Then
                .Add Cl.Value, Cl.Offset(, 6).Value
            Else
                .Item(Cl.Value) = .Item(Cl.Value) + Cl.Offset(, 6).Value
            End If
        Next Cl
        
        Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(.Count).Value = Application.Transpose(.Keys)
        Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(.Count).Value = Application.Transpose(.items)
        End With

End Sub