# Most common value as per certain cell

#### Jaffabfc

##### Board Regular
Hi,

I have a list of 60,000 rows of data and in column A i have 23,000 different values.
In column J i have multiple different codes, how can i find out what is the most common against different value of coulmn A.

So for example i would want the answer for 1 in column A to be Yellow
 Column A Column J 1 red 2 red 3 yellow 4 green 5 pink 6 black 7 white 8 black 9 white 10 black 1 yellow 1 yellow 1 yellow 1 red

<tbody>
</tbody>

Thanks

#### MickG

##### MrExcel MVP
Assuming data starts in "A1 & "J1"
Try this for results in columns "B & C".
Code:
``````[COLOR="Navy"]Sub[/COLOR] MG30Oct14
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[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] nStr        [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Num         [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]Set[/COLOR] Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
[COLOR="Navy"]End[/COLOR] If

[COLOR="Navy"]If[/COLOR] Not Dic(Dn.Value).exists(Dn.Offset(, 9).Value) [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]Else[/COLOR]
Dic(Dn.Value).Item(Dn.Offset(, 9).Value) = _
Dic(Dn.Value).Item(Dn.Offset(, 9).Value) + 1
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
[COLOR="Navy"]If[/COLOR] Dic(k).Item(p) > Num [COLOR="Navy"]Then[/COLOR]
Num = Dic(k).Item(p)
nStr = p
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] p
c = c + 1
Cells(c, "B") = k
Cells(c, "C") = nStr
nStr = "": Num = 0
[COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]``````
Regards Mick

#### Jaffabfc

##### Board Regular
Assuming data starts in "A1 & "J1"
Try this for results in columns "B & C".
Code:
``````[COLOR=Navy]Sub[/COLOR] MG30Oct14
[COLOR=Navy]Dim[/COLOR] Dn          [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Rng         [COLOR=Navy]As[/COLOR] Range
[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] nStr        [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]Dim[/COLOR] Num         [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR=Navy]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = 1
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
[COLOR=Navy]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
[COLOR=Navy]Set[/COLOR] Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
[COLOR=Navy]End[/COLOR] If

[COLOR=Navy]If[/COLOR] Not Dic(Dn.Value).exists(Dn.Offset(, 9).Value) [COLOR=Navy]Then[/COLOR]
[COLOR=Navy]Else[/COLOR]
Dic(Dn.Value).Item(Dn.Offset(, 9).Value) = _
Dic(Dn.Value).Item(Dn.Offset(, 9).Value) + 1
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] Dn

[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] k [COLOR=Navy]In[/COLOR] Dic.Keys
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] p [COLOR=Navy]In[/COLOR] Dic(k)
[COLOR=Navy]If[/COLOR] Dic(k).Item(p) > Num [COLOR=Navy]Then[/COLOR]
Num = Dic(k).Item(p)
nStr = p
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] p
c = c + 1
Cells(c, "B") = k
Cells(c, "C") = nStr
nStr = "": Num = 0
[COLOR=Navy]Next[/COLOR] k
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]``````
Regards Mick
sorry do i have to do this as VBA (i think its called) not right clued up with that.

is there no formula such as MAXIF with something else.

#### Jaffabfc

##### Board Regular
can someone not help me with this?

thanks

#### MickG

##### MrExcel MVP
I'm not able to provide a formula for you ,but if you would like to try the previous code, follow the instruction below:-

To Save and Run Code:-
In Your Data sheet , Click "Alt+F11",:- Vb Window appears.
From the VBWindow toolbar, Click "Insert" ,"Module":- New VBwindow appears .
Paste Code into this window.
Close Vbwindow.

On sheet Click "Developer tab", Click "Macro". Macro dialog box appears.
Select Macro (with same Code name) from List.
On the right of Dialog box Click "Run"
The Sheet should now be updated.
Regrds Mick