Organization Data

[elsg]

How change data in sheet this way.
Before
[TABLE="class: grid, width: 242"]
<colgroup><col><col><col><col></colgroup><tbody>[TR]
[TD]Number[/TD]
[TD]User[/TD]
[TD]Name[/TD]
[TD]Department[/TD]
[/TR]
[TR]
[TD]888 888[/TD]
[TD="align: right"]1[/TD]
[TD]Name A[/TD]
[TD]commercial[/TD]
[/TR]
[TR]
[TD]888 888[/TD]
[TD="align: right"]5[/TD]
[TD]Name B[/TD]
[TD]logistics[/TD]
[/TR]
[TR]
[TD]888 888[/TD]
[TD="align: right"]4[/TD]
[TD]Name C[/TD]
[TD]commercial[/TD]
[/TR]
[TR]
[TD]888 888[/TD]
[TD="align: right"]6[/TD]
[TD]Name D[/TD]
[TD]commercial[/TD]
[/TR]
[TR]
[TD]888 888[/TD]
[TD="align: right"]3[/TD]
[TD]Name E[/TD]
[TD]management[/TD]
[/TR]
[TR]
[TD]888 888[/TD]
[TD="align: right"]2[/TD]
[TD]Name F[/TD]
[TD]logistics[/TD]
[/TR]
</tbody>[/TABLE]

After
[TABLE="class: outer_border, width: 340"]
<colgroup><col><col><col></colgroup><tbody>[TR]
[TD]Department commercial[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Number[/TD]
[TD]User[/TD]
[TD]Name[/TD]
[/TR]
[TR]
[TD]888 888[/TD]
[TD="align: right"]1[/TD]
[TD]Name A[/TD]
[/TR]
[TR]
[TD]888 888[/TD]
[TD="align: right"]4[/TD]
[TD]Name C[/TD]
[/TR]
[TR]
[TD]888 888[/TD]
[TD="align: right"]6[/TD]
[TD]Name D[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Department commercial logistics[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Number[/TD]
[TD]User[/TD]
[TD]Name[/TD]
[/TR]
[TR]
[TD]888 888[/TD]
[TD="align: right"]5[/TD]
[TD]Name B[/TD]
[/TR]
[TR]
[TD]888 888[/TD]
[TD="align: right"]2[/TD]
[TD]Name F[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Department commercial management[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Number[/TD]
[TD]User[/TD]
[TD]Name[/TD]
[/TR]
[TR]
[TD]888 888[/TD]
[TD="align: right"]3[/TD]
[TD]Name E[/TD]
[/TR]
</tbody>[/TABLE]


Cross-Post
splitting data

Thank you!!

 

[MickG]

Try this , Results start "F1"

[COLOR="Navy"]Sub[/COLOR] MG13Feb26
[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("d2"), Range("d" & Rows.Count).End(xlUp))
ReDim Ray(1 To Rng.Count * 2, 1 To 3)
[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, G [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] .keys
    c = c + 1
    Ray(c, 1) = "Department" & " " & k
    c = c + 1: Ray(c, 1) = "Number": Ray(c, 2) = "User": Ray(c, 3) = "Name"
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] G [COLOR="Navy"]In[/COLOR] .Item(k)
    c = c + 1
    Ray(c, 1) = G.Offset(, -3).Value: Ray(c, 2) = G.Offset(, -2).Value: Ray(c, 3) = G.Offset(, -1).Value
[COLOR="Navy"]Next[/COLOR] G
[COLOR="Navy"]Next[/COLOR] k
Range("F1").Resize(c, 3) = Ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[elsg]

Your code is perfect!!!!!!!!!!!!

Thank you very much!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

 

[MickG]

You're welcome