Appendix Thread. App Index Rws() Clms() Majic code line Codings for other Threads, Tables etc) TEST COPY

**DocAElstein** · 04-24-2023, 03:56 PM

Code:

Sub AlanReporting() '    https://excelfox.com/forum/showthread.php/2837-Appendix-Thread-App-Index-Rws()-Clms()-Majic-code-line-Codings-for-other-Threads-Tables-etc-)?p=19941&viewfull=1#post19941
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets.Item(1)
Dim arrIn() As Variant: Let arrIn() = Ws1.Range("A1").CurrentRegion.Value2
Dim arr1DArrays() As Variant: ReDim arr1DArrays(1 To UBound(arrIn(), 1)) '
Dim Lr As Long: Let Lr = UBound(arrIn(), 1)
Rem 1 some initial lines in the final output, based on the   Restrictions  of  one Boss and 1 deputy, so in other words one level 1 and one level 2
 Let arr1DArrays(1) = Application.Index(Ws1.Cells, 1, Array(1, 4, 2, 5, 6)): arr1DArrays(2) = Application.Index(Ws1.Cells, 2, Array(1, 4, 2, 5, 6)): arr1DArrays(3) = Application.Index(Ws1.Cells, 3, Array(1, 4, 2, 5, 6)): arr1DArrays(4) = Application.Index(Ws1.Cells, 4, Array(1, 4, 2, 5, 6))
Rem 2a
Dim Dw As Long: Let Dw = 4
Dim srchVl As String: Let srchVl = arrIn(Dw, 2)
Dim arrInds3() As Variant: Let arrInds3() = Ws1.Evaluate("=IF(C5:C" & Lr & "=$B$4,ROW(B5:B" & Lr & "),0)")
Rem 3b
Dim Inds3 As Long
    For Inds3 = 1 To UBound(arrInds3(), 1)
     If arrInds3(Inds3, 1) = 0 Then: Dim Lvl3s As Long: Let Lvl3s = Inds3 - 1: Exit For
    Next Inds3
Rem 4a
'  now we want to investigate all the level 4s reporting to all the level 3s
Dim CntInds3 As Long ' Outer loop, Looping all level 3s ' ===================================================
    For CntInds3 = 1 To Lvl3s ' Looping all level 3s
     Let Dw = Dw + 1
     Let arr1DArrays(Dw) = Application.Index(Ws1.Cells, 5 + CntInds3 - 1, Array(1, 4, 2, 5, 6))
    Rem 4b
    Dim arrInds4() As Variant: Let arrInds4() = Ws1.Evaluate("=IF(C" & 5 + Lvl3s & ":C" & Lr & "=$B$" & 5 + CntInds3 - 1 & ",ROW(C" & 5 + Lvl3s & ":C" & Lr & "),0)")
    Rem 4c
    Dim CntInds4s As Long ' Inner loop, Looping all level 4s for a level 3 ' --------------------------------
        For CntInds4s = 1 To UBound(arrInds4(), 1)
            If arrInds4(CntInds4s, 1) = 0 Then
            
            Else
             Let Dw = Dw + 1 '
             Let arr1DArrays(Dw) = Application.Index(Ws1.Cells, arrInds4(CntInds4s, 1), Array(1, 4, 2, 5, 6))
            End If
        Next CntInds4s ' ------------------------------------------------------------------------------------
    Next CntInds3 ' =========================================================================================
Rem 5 Output - convert the 1D array of 1D array output rows to a 2D range form
 Let Range("AE1").Resize(Lr, 5).Value2 = Application.Index(arr1DArrays(), Evaluate("=ROW(1:" & Lr & ")"), Evaluate("=COLUMN(A:E)"))
End Sub

_____ Workbook: report.xls ( Using Excel 2007 32 bit )

_Row\^Col	AE	AF	AG	AH	AI
1	DATA
2	DIVISION	LEVEL_NO	POSITION	empno	code
3	XX	1	OZ00301	E1	LL81
4	XX	2	LR0201	E2	LL82
5	XX	3	LA0101	E3	LL83
6	XX	4	XX0101	E11	LL91
7	XX	4	XX0102	E12	LL92
8	XX	4	XX0103	E13	LL93
9	XX	4	XX0104	E14	LL94
10	XX	3	LA0201	E4	LL84
11	XX	4	XX0502	E6	LL86
12	XX	4	XX0601	E7	LL87
13	XX	4	XX1901	E8	LL88
14	XX	4	XX2101	E9	LL89
15	XX	4	XX0501	E17	LL97
16	XX	3	LA0701	E5	LL85
17	XX	4	XX2201	E10	LL90
18	XX	4	XX0201	E15	LL95
19	XX	4	XX0301	E16	LL96