I am attempting to write a macro in Excel that is a bit complex (at least for me) to assist at work. I have a list of employees and their salary ranges and I want to be able to break the sheet up by managers and their direct/indirect reports. For example: John Smith is the VP and has 5 direct reports, I want the macro to grab the 5 ranges of those direct reports, but also the ranges of the direct reports (if any) of those 5 people. So John Smith would receive the salary ranges of all the people in this example, but Sam Jones would only receive his 2 direct reports and the 3 direct reports of Jane Doe as she is a direct report of Sam. Hopefully that somewhat makes sense! It can also delete any duplicate ranges (if career level, grade, zone, structure are the same for more than one person). One more, if it could please save the file under the name of the manager - thank you!

These would be the expected results when running the macro, in this example it would output 3 workbooks:

John Smith Output

Sam Jones Output

Jane Doe Output

CodePudding user response：

Here's an example of how you can filter your table to show all direct and indirect reports for a given manager id:

Option Explicit

Const COL_EMP_ID As Long = 2  'col# with employee id
Const COL_MGR_ID As Long = 6  'col# with manager id

Sub TestReportFiltering()
    Dim rngData As Range
    
    'your "staff data" table...
    With ThisWorkbook.Worksheets("aaphr")
        Set rngData = .Range("A1").CurrentRegion
        FilterReports rngData, .Range("T1").Value 'for example
    End With
    'now copy the filtered data...

End Sub

Sub FilterReports(rngData As Range, mgrId)
    
    Dim arrEmpId, arrMgrId, arrFilt(), mgrs As New Collection, mgr
    Dim r As Long, numRecs As Long
    
    arrEmpId = rngData.Columns(COL_EMP_ID).Value
    arrMgrId = rngData.Columns(COL_MGR_ID).Value
    numRecs = UBound(arrEmpId)
    ReDim arrFilt(1 To numRecs, 1 To 1)
    arrFilt(1, 1) = "Filter"
    
    mgrs.Add mgrId 'add the provided manager id
    
    Do While mgrs.Count > 0
        mgr = CStr(mgrs(1))                      'get the first manager id
        mgrs.Remove 1                            'then remove it
        For r = 2 To numRecs                     'loop over records
            If CStr(arrMgrId(r, 1)) = mgr Then   'reports to `mgr` ?
                arrFilt(r, 1) = "x"              'set flag in `arrFilt`
                mgrs.Add arrEmpId(r, 1) 'in case this employee has reports...
            End If
        Next r
    Loop
      
    On Error Resume Next
    rngData.Parent.ShowAllData 'clear any existing filtering
    On Error GoTo 0
    'add our array of flags and filter on that range
    With rngData.Columns(rngData.Columns.Count).Offset(0, 2)
        .Value = arrFilt
        .AutoFilter Field:=1, Criteria1:="x"
    End With
    
End Sub

Note there's no error handling for the case where there's a circular reporting relationship (A reports to B and B reports to A)...