adding queue numbers to end of same rows - macro

[osmanoca]

hello please help me about same words in column B. i have dic data and meanings are in Column B. but some rows are same. so i need to add queue number to end of word to be different from eachother.

example:

A B
Book note
lesson note
teach make learn
desk note
class make learn

i want them as below: only adding numbers to be different:
A B
Book note (1)
lesson note (2)
teach make learn (1)
desk note (3)
class make learn (2)

please dear helpfull sir and friends. help me with macro...
thanks alot

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG17Aug18
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/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]
        .Add Dn.Value, Dn
    [COLOR="Navy"]Else[/COLOR]
        [COLOR="Navy"]Set[/COLOR] .Item(Dn.Value) = Union(.Item(Dn.Value), Dn)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, P [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    c = 0
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] P [COLOR="Navy"]In[/COLOR] .Item(K)
        c = c + 1
        P.Value = P.Value & " (" & c & ")"
    [COLOR="Navy"]Next[/COLOR] P
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[osmanoca]

it worked thanks very much dear MickG. Really thanks. God help you.

Try this:-

[COLOR=Navy]Sub[/COLOR] MG17Aug18
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/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]
        .Add Dn.Value, Dn
    [COLOR=Navy]Else[/COLOR]
        [COLOR=Navy]Set[/COLOR] .Item(Dn.Value) = Union(.Item(Dn.Value), Dn)
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]
[COLOR=Navy]Dim[/COLOR] K [COLOR=Navy]As[/COLOR] Variant, P [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] K [COLOR=Navy]In[/COLOR] .keys
    c = 0
    [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] P [COLOR=Navy]In[/COLOR] .Item(K)
        c = c + 1
        P.Value = P.Value & " (" & c & ")"
    [COLOR=Navy]Next[/COLOR] P
[COLOR=Navy]Next[/COLOR] K
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

 

[osmanoca]

thanks for code. but i saw it added numbers to rows that are not dublicated also. i dont want the the rows that are not dubilcated to be with number. please if you can correct to add numbers to rows that are more than one only. not needed for unique rows. thanks.

Try this:-

[COLOR=Navy]Sub[/COLOR] MG17Aug18
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/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]
        .Add Dn.Value, Dn
    [COLOR=Navy]Else[/COLOR]
        [COLOR=Navy]Set[/COLOR] .Item(Dn.Value) = Union(.Item(Dn.Value), Dn)
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]
[COLOR=Navy]Dim[/COLOR] K [COLOR=Navy]As[/COLOR] Variant, P [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] K [COLOR=Navy]In[/COLOR] .keys
    c = 0
    [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] P [COLOR=Navy]In[/COLOR] .Item(K)
        c = c + 1
        P.Value = P.Value & " (" & c & ")"
    [COLOR=Navy]Next[/COLOR] P
[COLOR=Navy]Next[/COLOR] K
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

 

[osmanoca]

please help any firend. i writed message above for editing code.

 

[MickG]

Add the two lines shown in red :-

For Each K In .keys
    c = 0
[B][COLOR=#FF0000]    If .Item(K).Count > 1 Then[/COLOR][/B]
        For Each P In .Item(K)
            c = c + 1
            P.Value = P.Value & " (" & c & ")"
        Next P
  [B][COLOR=#FF0000]  End If[/COLOR][/B]
Next K
End With
End Sub