Linked List Hierarchy extraction

Vishesh's picture

The following code filters a list of employee falling under the select employee in a hierarchy. Download the attached file and see how it works.

Employee Hierarchy

 

 

Option Explicit
 
Option Compare Text
 
 
 
Dim strFinalList As String
 
 
 
Sub Filter_Click()
 
 
 
    Dim strHead As String
 
 
 
    strFinalList = vbNullString
 
 
 
    strHead = InputBox("Employee Id:", "Linked list filter")
 
    If strHead = vbNullString Then Exit Sub
 
 
 
    'Pass Employee Id Col# and Manager Id Col# or you can have your

    'own search columns

    Call FilterList(Sheet1.Range("A1").CurrentRegion, strHead, 1, 3)
 
 
 
End Sub
 
 
 
Sub FilterList(rngDataWithHeader As Range, strEmployee As String, intEmployeeCol As Integer, intManagerCol As Integer)
 
 
 
    Dim wks As Worksheet
 
    Dim arrData
 
 
 
    Set wks = rngDataWithHeader.Parent
 
    strFinalList = vbNullString
 
 
 
    arrData = rngDataWithHeader
 
 
 
    Call GetReportees(strEmployee, arrData, intEmployeeCol, intManagerCol)
 
 
 
    Application.ScreenUpdating = False
 
 
 
    If Not wks.AutoFilterMode = False Then wks.AutoFilterMode = False
 
 
 
    strFinalList = strFinalList & ";" & strEmployee
 
    rngDataWithHeader.AutoFilter Field:=intEmployeeCol, Criteria1:=Split(strFinalList, ";"), Operator:=xlFilterValues
 
 
 
    Application.ScreenUpdating = True
 
    strFinalList = vbNullString
 
 
 
    If IsArray(arrData) Then Erase arrData
 
    Set wks = Nothing
 
 
 
End Sub
 
 
 
Sub GetReportees(strHead As String, arr, intEmpIdCol As Integer, intManagerIdCol As Integer)
 
 
 
    Dim lngX            As Long
 
    Dim strReportees    As String
 
    Dim arrReportees
 
 
 
    For lngX = LBound(arr, 1) To UBound(arr, 1)
 
        If arr(lngX, intManagerIdCol) = strHead Then
 
            strReportees = strReportees & ";" & arr(lngX, intEmpIdCol)
 
        End If
 
    Next lngX
 
    strReportees = Mid(strReportees, 2)
 
 
 
    If strReportees <> vbNullString Then
 
        If strFinalList = vbNullString Then
 
            strFinalList = strReportees
 
        Else
 
            strFinalList = strFinalList & ";" & strReportees
 
        End If
 
 
 
        arrReportees = Split(strReportees, ";")
 
        For lngX = LBound(arrReportees, 1) To UBound(arrReportees, 1)
 
            Call GetReportees(CStr(arrReportees(lngX)), arr, intEmpIdCol, intManagerIdCol)
 
        Next lngX
 
    End If
 
 
 
    If IsArray(arrReportees) Then Erase arrReportees
 
 
 
End Sub
AttachmentSize
Link List Employee Hierarchy.xlsm18.23 KB