writing rows of common names

[sami204098]

hi

in cell g9 I want to put together the rows of each of the common names together(without helper column)

 

[sami204098]

in cell g9 I want to put together the rows of each of the common names together(without helper column)

 

[sami204098]

up.......

 

[Akuini]

in cell g9 I want to put together the rows of each of the common names together(without helper column)

Hi, sami204098
Question:
1. Is it ok to use vba?
2. So for tom the result would be in 3 rows (not just 1 row) because tom is separated in 3 groups in column D, is it right?

 

[sami204098]

1.Use of vba is not allowed.
2.yes.If the information of each person was below, one of the names should be included.

 

[MickG]

Try this for results starting "F9".

[COLOR="Navy"]Sub[/COLOR] MG01Nov16
[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] nStr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] R [COLOR="Navy"]As[/COLOR] Range, C [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range("D7", Range("D" & 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.Offset(, -1)
    [COLOR="Navy"]Else[/COLOR]
        [COLOR="Navy"]Set[/COLOR] .Item(Dn.Value) = Union(.Item(Dn.Value), Dn.Offset(, -1))
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
C = 8


[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
   [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] .Item(K).Areas
      [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Dn
        nStr = nStr & IIf(nStr = "", R, "," & R)
        [COLOR="Navy"]Next[/COLOR] R
         C = C + 1
        Cells(C, "F") = K
        Cells(C, "G") = nStr
        nStr = ""
   [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[sami204098]

Try this for results starting "F9".

[COLOR=Navy]Sub[/COLOR] MG01Nov16
[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] nStr [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]Dim[/COLOR] R [COLOR=Navy]As[/COLOR] Range, C [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] K [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Set[/COLOR] Rng = Range("D7", Range("D" & 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.Offset(, -1)
    [COLOR=Navy]Else[/COLOR]
        [COLOR=Navy]Set[/COLOR] .Item(Dn.Value) = Union(.Item(Dn.Value), Dn.Offset(, -1))
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]
C = 8


[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] K [COLOR=Navy]In[/COLOR] .keys
   [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] .Item(K).Areas
      [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] R [COLOR=Navy]In[/COLOR] Dn
        nStr = nStr & IIf(nStr = "", R, "," & R)
        [COLOR=Navy]Next[/COLOR] R
         C = C + 1
        Cells(C, "F") = K
        Cells(C, "G") = nStr
        nStr = ""
   [COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]Next[/COLOR] K
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

thanks but Use of vba is not allowed. If possible, solve with excel functions.