Add values from duplicate rows and delete duplicate

[jane204]

I have the below values and I want to create a macro to add the duplicates and delete it.

Apple=260 <tbody> </tbody>

Orange=3 <tbody> </tbody>

Banana=246 <tbody> </tbody>

Apple=43 <tbody> </tbody>

Mango=93 <tbody> </tbody>

Banana=4 <tbody> </tbody>

Melon=260 <tbody> </tbody>

Grape=209 <tbody> </tbody>

<tbody>
</tbody>

I want the result to combine the apples and banana which has duplicate values and give the total number of apples and bananas. Like below.

Apple=303 <tbody> </tbody>

Orange=3 <tbody> </tbody>

Banana=250 <tbody> </tbody>

Mango=93 <tbody> </tbody>

Melon=260 <tbody> </tbody>

Grape=209 <tbody> </tbody>

<tbody>
</tbody>

Thanks!

 

[MickG]

Try this:-
NB:- this code will alter the data in column "A"

[COLOR="Navy"]Sub[/COLOR] MG18Nov38
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, Sp [COLOR="Navy"]As[/COLOR] Variant, nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Sp = Split(Dn.Value, "=")
    [COLOR="Navy"]If[/COLOR] Not .Exists(Sp(0)) [COLOR="Navy"]Then[/COLOR]
        .Add Sp(0), Array(Dn, Sp(1))
    [COLOR="Navy"]Else[/COLOR]
        Q = .Item(Sp(0))
        Q(1) = Q(1) + CLng(Sp(1))
        Q(0).Value = Sp(0) & "=" & Q(1)
        .Item(Sp(0)) = Q
       [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = Dn Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
   [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
    [COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] nRng.EntireRow.Delete
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[jane204]

It works. Thank you!

 

[MickG]

You're welcome