"Name" and "Reports-to" Sequence Project

[LTDLogan]

Subject: Automate the reorganization of two columns based on the unique identifier "Name", and a corresponding "Reports-to" column.
Version: Office 365
OS: Windows 10
Urgency: Low
Examples Included

So I have a project that I am trying to work on in my free time (but could use some help with) to automate the reorganization of two columns based on their unique identifier ("Name") and a "Reports-to" column. The reports-to column consists of repeating values from the "Name" column and a single blank cell which will denote the first value in the sequence. As a sub-sequence of relationships meets its end, the next sequence will start with a second occurrence of the most superior value of that sub sequence. I will put an example in below. Basically, this will sort data by the supervisor and subordinate relationships in a vertical pattern. I imagine the solution to this being most feasible in VBA, however if anyone has any ideas utilizing embedded formulas or even a Query, I would love to hear your ideas. In fact, if you could get this into an Excel Query I would be ecstatic.

Some further explanation of what I imagine this to look like:
If a name has a subordinate, then it MUST have a second occurrence in the sequence, even the first value without a reports-to value must have a second occurrence as I show in my examples below. If a value does not have a subordinate it will only appear once.
The new sequence would preferably be on a separate sheet so that the data can be maintained in an alphabetical sort and the second sheet would be in the proper sequence

The Source Columns

NAME	REPORTS-TO
A	NULL
B	A
C	A
D	B
E	B
F	B
G	C
H	C
I	C
J	E
K	E
L	E
M	I
N	I
O	I

<tbody>
</tbody>

The adjacent sheet with the re-sequenced data

NAME	REPORTS-TO
A	NULL
A	NULL
B	A
C	A
B	A
D	B
E	B
F	B
E	B
J	E
K	E
L	E
C	A
G	C
H	C
I	C
I	C
M	I
N	I
O	I

<tbody>
</tbody>

Thank you so much. I truly appreciate all of you who help answer these questions every day. You're the best. This may be my first post, but I owe this community more than I can describe. Ya'll helped teach me Excel from the ground up and launched me into a career path in less than 10 months.
Best,
Logan

 

[MickG]

Try this for results in "D & E"

[COLOR="Navy"]Sub[/COLOR] MG02Dec20
[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"]Set[/COLOR] Rng = Range(Range("B2"), 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] .Item(Dn.Value) = Empty
[COLOR="Navy"]Next[/COLOR]

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Offset(, -1)
    [COLOR="Navy"]If[/COLOR] .exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        .Item(Dn.Value) = Dn.Offset(, 1).Value
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn


[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Range("D1:E1").Value = Array("NAME", "REPORTS-TO")
c = 1
 
 [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
        c = c + 1
        Cells(c, "D").Resize(, 2).Value = Array(K, .Item(K))
        Cells(c, "D").Resize(, 2).Font.Bold = True
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
            [COLOR="Navy"]If[/COLOR] .Item(K) = Empty [COLOR="Navy"]Then[/COLOR]
                 [COLOR="Navy"]If[/COLOR] Dn = K [COLOR="Navy"]Then[/COLOR] Cells(c, "D").Resize(, 2).Value = Dn.Offset(, -1).Resize(, 2).Value
            [COLOR="Navy"]Else[/COLOR]
                [COLOR="Navy"]If[/COLOR] Dn.Value = .Item(K) And Dn.Offset(, -1).Value = K [COLOR="Navy"]Then[/COLOR]
                    [COLOR="Navy"]For[/COLOR] n = 1 To Rng.Count
                        [COLOR="Navy"]If[/COLOR] Dn.Offset(n).Value = K [COLOR="Navy"]Then[/COLOR]
                            c = c + 1
                            Cells(c, "D") = Dn.Offset(n, -1).Value
                            Cells(c, "E") = Dn.Offset(n).Value
                        [COLOR="Navy"]End[/COLOR] If
                     [COLOR="Navy"]Next[/COLOR] n
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[LTDLogan]

Thank you, Mick!
Your code did it perfectly in reference to the data that I provided. Unfortunately, there are some small glitches.
When I scramble up the list, it gets all out of wack. The ABC's in the Name column are placeholders and their reports to will not be in any ordered fashion either.

Sub Calldown_Creator_v1()
'Use this macro to create a calldown based on 2 columns of data.
'The first column must contain the staff names.
'The second column must contain the staff member that they report to
'The  must be the only staff member without a reports-to value
'
'
'
Sheets("Staff List").Select
        Dim sourceCol As Integer, rowCount As Integer, currentRow As Integer, i As Integer, j As Integer, k As Integer
       
    Dim currentRowValue As String
 
    sourceCol = 2   'column B has a value of 2
    rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row
    j = 2
   
 
'for every row, find the first blank cell and select it
    For currentRow = 1 To rowCount
        currentRowValue = Cells(currentRow, sourceCol).Value
        If IsEmpty(currentRowValue) Or currentRowValue = "" Then
            Cells(currentRow, sourceCol).Select
        End If
        Next
            Range(ActiveCell, ActiveCell.End(xlToLeft)).Copy
Sheets("Calldown").Activate
            Range(Cells(2, 1), Cells(2, 2)).PasteSpecial xlPasteValues
'
'--- is now at the top of the calldown
For i = 2 To rowCount
Sheets("Staff List").Select
            If (Cells(i, 2).Value = ThisWorkbook.Sheets("Calldown").Cells(j, 1)) Then
            j = j + 1
            Range(Cells(i, 1), Cells(i, 2)).Copy
            Sheets("Calldown").ActivateS
            Range(Cells(j, 1), Cells(j, 2)).PasteSpecial xlPasteValues
            Else
        End If
        Next
                       
End Sub

So this was my first attempt at the macro. Maybe It can give you a better idea of what I was looking for.

 

[MickG]

I thought that might be the case !!!
The only way I might be able to give a more reliable code is for you to post an more comprehensive example of your data and the expected results that cover the short comings of my original code.