Merge, count non-zero cells, delete duplicates

rinn

New Member
Joined
Aug 2, 2010
Messages
19
Hi, I was wondering whether anyone can help me with this?
I am trying to merge rows of data according to column A and count the non-zero cells in column B, then delete duplicates in A. An example is below.

A B
0 0
0 536
0 0
1 5687
1 6459
1 0
2 0
2 0
3 6893
3 67489
3 1247

I would like it to become:

A B
0 1
1 2
2 0
3 3

I have mulitple sheets in the workbook and therefore would like it in macro.
Can anyone help?

Thanks!
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Hi, Try this:-
NB:- This code will overwrite data in columns "A & B". "Test First" !!
Code:
[COLOR=navy]Sub[/COLOR] MG03Aug55
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Dn [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Bcol [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[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
    [COLOR=navy]If[/COLOR] Not .Exists(Dn.Value) [COLOR=navy]Then[/COLOR]
        Bcol = IIf(Dn(, 2) > 0, 1, 0)
        .Add Dn.Value, Bcol
    [COLOR=navy]Else[/COLOR]
        .Item(Dn.Value) = IIf(Dn(, 2) > 0, .Item(Dn.Value) + 1, .Item(Dn.Value))
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
Columns("A:B").ClearContents
Range("A1").Resize(.Count, 2) = Application.Transpose(Array(.Keys, .items))
[COLOR=navy]End[/COLOR] With
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 

rinn

New Member
Joined
Aug 2, 2010
Messages
19
Hi Mick,

Thanks for your reply.
It works!
Thanks so much!
Do you mind if you explain your code?
I am still very new to VBA and am in the proccess of learning while working on a file.
Sorry for the trouble.
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Hi, I've added some remarks Hope that Helps:-
Code:
[COLOR="Navy"]Sub[/COLOR] MG03Aug53
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Bcol [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
'[COLOR="Green"][B]'''''''''''''''''''''''''''''''''''''''''''''[/B][/COLOR]
'[COLOR="Green"][B]Scrip Dicionary Basically Find Unique values in a range of data[/B][/COLOR]
'[COLOR="Green"][B]and stores those values in the dictionary[/B][/COLOR]
'[COLOR="Green"][B]The Dictionary is set up to Store the Value in this case("Key")[/B][/COLOR]
'[COLOR="Green"][B]and the "Item" in this case Bcol[/B][/COLOR]
'[COLOR="Green"][B]''''''''''''''''''''''''''''''''''''''''''''[/B][/COLOR]
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
'[COLOR="Green"][B]Loop throught range[/B][/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    '[COLOR="Green"][B]If value (Dn.value)is not in Dic then Add[/B][/COLOR]
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
 '[COLOR="Green"][B]''''''''''''''''''''''''[/B][/COLOR]
       '[COLOR="Green"][B]The variable Bcol is the column "B " Value[/B][/COLOR]
       '[COLOR="Green"][B]If Bcol is greater than 0 then Bcol = 1 else = 0[/B][/COLOR]
'[COLOR="Green"][B]''''''''''''''''''''''''''[/B][/COLOR]
        Bcol = IIf(Dn(, 2) > 0, 1, 0)
        .Add Dn.Value, Bcol
    [COLOR="Navy"]Else[/COLOR]
'[COLOR="Green"][B]''''''''''''''''''''''''''''''''''''''''''''''''[/B][/COLOR]
  '[COLOR="Green"][B]If the same value is found again Then it is not added to "Dic"[/B][/COLOR]
  '[COLOR="Green"][B]But the same Value (which is is already in the dic" has an "Item" :- Bcol[/B][/COLOR]
  '[COLOR="Green"][B]So ".item(dn.value)" is The Value Bcol for that Value (dn.value) which is Already in the "Dic"[/B][/COLOR]
  '[COLOR="Green"][B]So when you refer to ".item(dn.value)" your actually referring To the item for that Unique Value     '[/B][/COLOR]
  '[COLOR="Green"][B]The Code below then Add "1" to Bcol for that value if is greater than "0"[/B][/COLOR]
 '[COLOR="Green"][B]'''''''''''''''''''''''''''''''''''''''''''''[/B][/COLOR]
        .Item(Dn.Value) = IIf(Dn(, 2) > 0, .Item(Dn.Value) + 1, .Item(Dn.Value))
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
Columns("A:B").ClearContents
'[COLOR="Green"][B]The "Keys" and "Items" are then set in an array and posted on the sheet[/B][/COLOR]
'[COLOR="Green"][B]".count" is the Count of Uniques in The range[/B][/COLOR]
Range("A1").Resize(.Count, 2) = Application.Transpose(Array(.Keys, .items))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 

rinn

New Member
Joined
Aug 2, 2010
Messages
19
Hi, thanks for the trouble!
It is clearer now.
I really appreciate it.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,629
Messages
5,838,454
Members
430,549
Latest member
jayjay2022

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top