Merge duplicates in ColA while picking most frequent value in ColB

[c2rn75]

Hi,

I have a spreadsheet with 130000 lines, and I would really appreciate some help in merging some of the data. I have searched the forum for help, and even though I found some related post, it did not solve my problem. I have lost of rows with duplicates of an unique ID (column A), and each ID may be associated with different values (Column B). I need to merge all the duplicate ID's into one row, and then pick the most frequent value in Column B as the new value for that row. Column A contain numbers, and Column B contain text strings. If there are eg 2 values in Column B that occur equally often, I dont care which one is chosen.

I have this:

A B

1	a
1	a
1	a
1	b
1	c
1	d
2	a
2	b
2	b
2	b
2	c
3	a
3	a
3	a
3	a
3	g
4	c
4	c
4	d
4	e
4	f

<colgroup><col span="2"></colgroup><tbody>
</tbody>

I want this:

1	a
2	b
3	a
4	c

<colgroup><col span="2"></colgroup><tbody>
</tbody>

Help on this is much appreciated, because manually doing this is not going to happen

Thanks
Cato

 

[oldbrewer]

1

a

1

a

a

1

a

1

a

aa

1

a

1

a

aaa

1

b

1

b

aaab

1

c

1

c

aaabc

1

d

1

d

aaabcd

aaabcd

2

a

2

a

a

2

b

2

b

ab

2

b

2

b

abb

2

b

2

b

abbb

2

c

2

c

abbbc

abbbc

3

a

3

a

a

3

a

3

a

aa

3

a

3

a

aaa

3

a

3

a

aaaa

3

g

3

g

aaaag

aaaag

4

c

4

c

c

4

c

4

c

cc

4

d

4

d

ccd

4

e

4

e

ccde

4

f

4

f

ccdef

ccdef

I want this:

1

a

2

b

by concatenating all the letters against 1,2,3,4

3

a

and then finding the longest concatenation

4

c

1

d

aaabcd

aaabcd

2

c

abbbc

abbbc

3

g

aaaag

aaaag

4

f

ccdef

ccdef

that reduces your 130,000 rows somewhat

I do not know how long your text strings are

or how many different text strings there are

<colgroup><col span="13"></colgroup><tbody>
</tbody>

 

[MickG]

Try this for data starting "A2"and results starting "C1".

[COLOR="Navy"]Sub[/COLOR] MG14Sep50
[COLOR="Navy"]Dim[/COLOR] Ray             [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] n               [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Dic             [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] k               [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] p               [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] c               [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] oMax            [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
    
 Ray = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp)).Resize(, 2)
 [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
   [COLOR="Navy"]For[/COLOR] n = 1 To UBound(Ray)
            [COLOR="Navy"]If[/COLOR] Not Dic.exists(Ray(n, 1)) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Ray(n, 1)) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
        
            [COLOR="Navy"]If[/COLOR] Not Dic(Ray(n, 1)).exists(Ray(n, 2)) [COLOR="Navy"]Then[/COLOR]
                Dic(Ray(n, 1)).Add (Ray(n, 2)), 1
            [COLOR="Navy"]Else[/COLOR]
                Dic(Ray(n, 1)).Item(Ray(n, 2)) = Dic(Ray(n, 1)).Item(Ray(n, 2)) + 1
            [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n
   
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
        c = c + 1
        Cells(c, "C") = k
           [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
               [COLOR="Navy"]If[/COLOR] Dic(k).Item(p) > oMax [COLOR="Navy"]Then[/COLOR]
                    oMax = Dic(k).Item(p)
                    Cells(c, "D") = p
               [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Next[/COLOR] p
            oMax = 0
    [COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[c2rn75]

Thanks Mick, I will try this out tomorrow!

 

[MickG]

You're welcome