find duplicate-create new column-write number coding

[elba7312]

Hi all,
Please I would like you to help me in creating a VBA code for:
1- find duplication in column B (picture is attached)

http://www.flickr.com/photos/63642645@N07/5792990942/in/photostream/

2-

2-a- if the serial number in column B is only one unique number, so write down in column c " 11 "
​

2-b- if the serial number in column B is duplicated twice, so write down in column c beside the first no. "21" and beside the second no. "22"
​

2-c- if the serial number in column B is duplicated 3 times, so write down in column c beside the first no. "31", beside the second no. "32" , and beside the third no. "33"
output picture is attached
​

http://www.flickr.com/photos/63642645@N07/5792992068/in/photostream/

Thanks a lot for help

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG04Jun11
[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]
[COLOR="Navy"]Dim[/COLOR] Rw [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B1"), Range("B" & 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]
n = n + 1
.Add Dn.value, Dn
Dn.Offset(, 1) = "11"
[COLOR="Navy"]Else[/COLOR]
    [COLOR="Navy"]Set[/COLOR] .Item(Dn.value) = Union(.Item(Dn.value), Dn)
        Num = IIf(.Item(Dn.value).Count = 2, 20, 30)
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Rw [COLOR="Navy"]In[/COLOR] .Item(Dn.value)
                Num = Num + 1
                Rw.Offset(, 1) = Num
            [COLOR="Navy"]Next[/COLOR] Rw
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick