Merge, count non-zero cells, delete duplicates

[rinn]

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!

 

[MickG]

Hi, Try this:-
NB:- This code will overwrite data in columns "A & B". "Test First" !!

[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]

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]

Hi, I've added some remarks Hope that Helps:-

[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]

Hi, thanks for the trouble!
It is clearer now.
I really appreciate it.