Page 54 of 54 FirstFirst ... 444525354
Results 531 to 538 of 538

Thread: Appendix Thread. 3 TEST COPY

  1. #531
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,466
    Rep Power
    10
    This is post
    https://excelfox.com/forum/showthread.php/2837-Appendix-Thread-App-Index-Rws()-Clms()-Majic-code-line-Codings-for-other-Threads-Tables-etc-)?p=19586&viewfull=1#post19586
    https://excelfox.com/forum/showthrea...ll=1#post19586
    https://excelfox.com/forum/showthrea...ge54#post19586
    https://excelfox.com/forum/showthread.php/2837-Appendix-Thread-App-Index-Rws()-Clms()-Majic-code-line-Codings-for-other-Threads-Tables-etc-)/page54#post19586





    In support of this main Forum Post http://www.eileenslounge.com/viewtop...301714#p301714

    Do the transpose a bit differently using Application.Index


    Consider this example of a Selectioned range:
    a b
    c d
    e f

    ,and we want an output of some form like a b c d e f
    Consider first a single column such as the first,
    Let vTemp = Application.Transpose(Selection.Columns(1)) ' gives - {"a", "c", "e"}
    We can Do the transpose a bit differently using Application.Index
    Let vTemp = Application.Index(Selection, Array(1, 2, 3), Array(1, 1, 1)) ' - {"a", "c", "e"}
    What's going on: Excel / Excel VBA is doing what it often does, along a row, then down a column, sometimes referred to as array type calculations, in this case the argument arrays are followed leading to an output of a form of the 1 dimensions, ("pseudo horizontal") array , as we want. The index works three times on each pair of co ordinates, each time giving the result in the way Index would in the more conventional way for just 1 pair of row and column co ordinates
    Using this index way we are not restricted to a single column, we can pick any co ordinates we chose.
    The next co ordinates give us a simple single line of all our cell values
    Let vTemp = Application.Index(Selection, Array(1, 1, 2, 2, 3, 3), Array(1, 2, 1, 2, 1, 2)) ' {"a", "b", "c", "d", "e", "f"}
    ' Or
    Dim Rws() As Variant, Clms() As Variant
    Let Rws() = Array(1, 1, 2, 2, 3, 3): Clms() = Array(1, 2, 1, 2, 1, 2)
    Let vTemp = Application.Index(Selection, Rws(), Clms()) ' ' {"a", "b", "c", "d", "e", "f"}


    To make a more useful flexible solution, what we need to do is to get those array arguments dynamically from, in this example, the Selection
    So on the face of it, it is quite easy what we need to do: It is usually just some seemingly clever, but actually quite basic maths. It is helpful perhaps to get in the head where/ why the problem / need for the maths comes in. It’s the difference between computers and us: Computers keep going, often things are listed or numbered in sequential number s ( example see item number way of doing things , https://excelfox.com/forum/showthrea...column-looping ) but we use a paper/book or screen so keep going back/ (returning to the left) then up/down, (“Line feeding”)
    In the various maths, the row count would usually feature less, or will feature in a similar way for slightly different examples, since mainly it effects ( along with the column count ) a final total number. In some examples the total number may be used and so the row count may never feature in any maths.
    The column count is more prominent, since this size restriction is the human wanted chopping up of things to get them within our limited view, ( Generally we have a more limited width ( column ) than length (row) perception: we scroll more hapilly down than across. I don’t. My brain is more open minded and wide.
    So we should be thinking more in terms of column count effecting things

    Consider the requirement for the Rws()
    For the case of more than one column, the sequential numbers need to be repeated for as many times as we have columns. So it is possibly a good guess that some division of that column count would be useful. Doing that division will give us
    {.5, 1, 1.5, 2, 2.5, 3}
    Observation of that shows we see something similar in the whole part of the numbers to what we want. But we don’t quite get what we want by taking the integer. We get
    {0, 1, 1, 2, 2, 3}
    We need to do something to correct what we get to what we want. It may not be obvious what we should do. If we consider another example it might help. So let’s consider 3 columns. Applying the same logic we would get
    {0, 0, 1, 1, 1, 2}
    It seems that the numbers which are to be dived by the column count and then taken the integer of, should not be {1, 2, 3, 4, 5, 6} , but for the case of 2 columns
    {2, 3, 4, 5, 6, 7}
    , and for the case of 3 columns
    {3, 4, 5, 6, 7, 8}
    So it looks like we want to add (ColumnCount-1) before the integer is done

    Consider the requirement for the Clms()
    We want to keep repeating the column sequence. The Mod function is promising for this, since it gives us what is left over after taking off as many as possible of the given number in the second argument. So whatever this gives us, will be repeated .
    This, Mod(Column(A:F),2) , almost gets us there with {1, 0, 1, 0, 1, 0} and checking the same logic for 3 columns we have {1, 2, 0, 1, 2, 0}
    We need to tweak that to get us to start at 0 and then add 1

    _.______


    Those ideas are incorporated into the full code version in the next post, https://excelfox.com/forum/showthrea...ll=1#post19591

    Ref:
    http://www.excelforum.com/excel-prog...umn-range.html
    http://www.excelforum.com/excel-prog...e-columns.html
    Seasonal greetings :-)

  2. #532
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,466
    Rep Power
    10
    Coding for last post

    Code:
    ' https://excelfox.com/forum/showthread.php/2837-Appendix-Thread-App-Index-Rws()-Clms()-Majic-code-line-Codings-for-other-Threads-Tables-etc-)?p=19586&viewfull=1#post19586
    ' http://www.eileenslounge.com/viewtopic.php?f=27&t=38973&p=301714#p301714
    Sub TransposeABitDifferent()
    ' Consider a two column, three row selection
     '  a   b
     '  c   d
     '  e   f
    Dim vTemp As Variant ' Use variant, and set a  Shift+F9  watch on it ( To do this: Highlight it anywhere in the coding and use keys  Shift+F9  )
    ' A single column transpose
     Let vTemp = Application.Transpose(Selection.Columns(1))           '  gives  - {"a", "c", "e"}
    ' Or   we can  Transpose in a different way, with index, and Stuff
     Let vTemp = Application.Index(Selection, Array(1, 2, 3), Array(1, 1, 1))  ' - {"a", "c", "e"}
    ' What's going on: Excel / Excel VBA is doing what it often does,  along a row, then down a column, sometimes referred to as array type calculations, in this case the argument arrays are followed leading to an output of a form of the 1 dimensions, ("pseudo horizontal") array , as we want. The index works three times on each pair of co ordinates, each time giving the result in the way Index would in the more conventional way for just 1 pair of row and column co ordinates
    ' using this way we are not restricted to a single column, we can pick any co ordinates we chose.
    ' The next co ordinates give us a simple single line of all our cell values
    Let vTemp = Application.Index(Selection, Array(1, 1, 2, 2, 3, 3), Array(1, 2, 1, 2, 1, 2)) ' {"a", "b", "c", "d", "e", "f"}
    ' Or
    Dim Rws() As Variant, Clms() As Variant
     Let Rws() = Array(1, 1, 2, 2, 3, 3): Clms() = Array(1, 2, 1, 2, 1, 2)
     Let vTemp = Application.Index(Selection, Rws(), Clms()) '                                ' {"a", "b", "c", "d", "e", "f"}
     
    ' To make a more useful flexible solution, what we need to do is to get those array arguments dynamically from the  Selection
    ' For both array aguments we need a 6 element 1 dimensional array
    ' ( we hit a snag generally in these things in that often Excel has those arrays but won't give us them, - typically it may only give us the first value. Noone is quite sure why. There are various tricks found empirically to make Excel give us the full array of values. Usually it involves putting what we actually want to do inside something that encourages Excel to return us all array values. (There may be some parallel to the so called  C S E  action in a spreadsheet to get full array results, noone is quite sure). Herfe is a trick I found, empirically to often work
    '  If({1},   here what you want to do   )      I don't always need to do this. During the development of a solution I monitor ma results in  vTemp  , and if I onbl
    
    ' The start point is usually to get an array of the size we want of integers, and then fiddle with some maths to get the actual integer values we want
     Let vTemp = Evaluate("=Column(A:F)") '     {1, 2, 3, 4, 5, 6}
    '  For a flexible solution we want the   F  Getting at a column letter is often a bit tricky, strangely Excel never made a function for it, whereas getting the column number is usually easy.
    '  In our case the column numnber is given by  Selection.clumns.count
     Let vTemp = Selection.Cells.Count   '   6
    ' there are a few ways to convert that to the appropriat Letter. An address way is convenient
     Let vTemp = Split(Cells(1, 6).Address, "$")(1) '   -  "F"        This splits any row cell in column 6 address, in this example the cell $F$1, by a  "$"  resulting in an array  {"", "F", "1"), we thne take the second element, which has the indice of  1  , (not  2  ,since  such an array starts at the indicie of  0)
     Let vTemp = Split(Cells(1, Selection.Cells.Count).Address, "$")(1)  '   - "F"
     
     Let vTemp = Evaluate("=Column(A:" & Split(Cells(1, Selection.Cells.Count).Address, "$")(1) & ")") '     {1, 2, 3, 4, 5, 6}
    ' ( To make the next steps easy to follow, we will stay with the  "F"   hard coded then substitute the bit to get it flexible later
     Let vTemp = Evaluate("=Column(A:F)") '     {1, 2, 3, 4, 5, 6}
    ' Some maths now. There are probably a few ways. We fiddle around a bit.  We try to get it using some numbers we could get dynamically, things typically of the count nature, such as row and column count, which are  3  and  2  in this example
    ' Rws()
     Let vTemp = Evaluate("=Column(A:F)/2") ' {.5, 1, 1.5, 2, 2.5, 3}
     Let vTemp = Evaluate("=Int(Column(A:F)/2)") ' 0
     Let vTemp = Evaluate("=If({1},Int(Column(A:F)/2))")  '  {0, 1, 1, 2, 2, 3}
     Let vTemp = Evaluate("=Int((Column(A:F)+2)/2)") ' 1
     Let vTemp = Evaluate("=If({1},Int((Column(A:F)+2)/2))") '
     Let vTemp = Evaluate("=If({1},Int((Column(A:F)+(2-1))/2))")
     Let vTemp = Evaluate("=If({1},Int((Column(A:F)+(" & Selection.Columns.Count & "-1))/" & Selection.Columns.Count & "))")
     
     Let vTemp = Evaluate("=If({1},Int((Column(A:" & Split(Cells(1, Selection.Cells.Count).Address, "$")(1) & ")+(" & Selection.Columns.Count & "-1))/" & Selection.Columns.Count & "))")
     Let Rws() = Evaluate("=If({1},Int((Column(A:" & Split(Cells(1, Selection.Cells.Count).Address, "$")(1) & ")+(" & Selection.Columns.Count & "-1))/" & Selection.Columns.Count & "))")
    
    ' Clms()
     Let vTemp = Evaluate("=Mod(Column(A:F),2)") ' 1
     Let vTemp = Evaluate("=If({1},Mod(Column(A:F),2))")       ' {0, 1, 0, 1, 0, 1}
     Let vTemp = Evaluate("=If({1},Mod((Column(A:F)-1),2)+1)") ' {1, 2, 1, 2, 1, 2}
     Let vTemp = Evaluate("=If({1},Mod((Column(A:" & Split(Cells(1, Selection.Cells.Count).Address, "$")(1) & ")-1),2)+1)")
     Let Clms() = Evaluate("=If({1},Mod((Column(A:" & Split(Cells(1, Selection.Cells.Count).Address, "$")(1) & ")-1),2)+1)")
    
    
    Let vTemp = Application.Index(Selection, Rws(), Clms()) '                                ' {"a", "b", "c", "d", "e", "f"}
    
    ' Do the Join
    Dim StrOut As String
     Let StrOut = Join(vTemp, ";"): Debug.Print StrOut   '       a;b;c;d;e;f
    End Sub
    '
    '
    ' Ref
    ' http://www.excelforum.com/excel-programming-vba-macros/1138428-multidimensional-array-to-single-column-range.html
    ' http://www.excelforum.com/excel-programming-vba-macros/1138627-dividing-the-items-of-an-array-over-multiple-columns.html
    
    Sub SnberOne()  '   http://www.eileenslounge.com/viewtopic.php?p=301714&sid=4705abb7ec796b7a3426c78642d4f638#p301714
     Let Selection.Resize(1, 1).Offset(0, Selection.Columns.Count).value2 = Join(Application.Index(Selection, Evaluate("=If({1},Int((Column(A:" & Split(Cells(1, Selection.Cells.Count).Address, "$")(1) & ")+(" & Selection.Columns.Count & "-1))/" & Selection.Columns.Count & "))"), Evaluate("=If({1},Mod((Column(A:" & Split(Cells(1, Selection.Cells.Count).Address, "$")(1) & ")-1),2)+1)")), VBA.InputBox("separator", , ";")) '       a;b;c;d;e;f
    End Sub
    Seasonal greetings :-)

  3. #533
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,466
    Rep Power
    10
    Some notes for this main forum post
    https://eileenslounge.com/viewtopic.php?f=27&t=39588


    https://postimg.cc/RqMKRrNz

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

    Row\Col A B C D E F I J K L M
    1 DATA REQUIRE
    2 DIVISION POSITION POSITION REPORTING LEVEL_NO empno code DIVISION LEVEL_NO POSITION empno code
    3 XX OZ00301 INDOL 1 E1 LL81 XX 1 OZ00301 E1 LL81
    4 XX LR0201 OZ00301 2 E2 LL82 XX 2 LR0201 E2 LL82
    5 XX LA0101 LR0201 3 E3 LL83 XX 3 LA0101 E3 LL83
    6 XX LA0201 LR0201 3 E4 LL84 XX 4 XX0101 E11 LL91
    7 XX LA0701 LR0201 3 E5 LL85 XX 4 XX0102 E12 LL92
    8 XX XX0502 LA0201 4 E6 LL86 XX 4 XX0103 E13 LL93
    9 XX XX0601 LA0201 4 E7 LL87 XX 4 XX0104 E14 LL94
    10 XX XX1901 LA0201 4 E8 LL88 XX 3 LA0201 E4 LL84
    11 XX XX2101 LA0201 4 E9 LL89 XX 4 XX0501 E17 LL97
    12 XX XX2201 LA0701 4 E10 LL90 XX 4 XX0502 E6 LL86
    13 XX XX0101 LA0101 4 E11 LL91 XX 4 XX0601 E7 LL87
    14 XX XX0102 LA0101 4 E12 LL92 XX 4 XX1901 E8 LL88
    15 XX XX0103 LA0101 4 E13 LL93 XX 4 XX2101 E9 LL89
    16 XX XX0104 LA0101 4 E14 LL94 XX 3 LA0701 E5 LL85
    17 XX XX0201 LA0701 4 E15 LL95 XX 4 XX0201 E15 LL95
    18 XX XX0301 LA0701 4 E16 LL96 XX 4 XX0301 E16 LL96
    19 XX XX0501 LA0201 4 E17 LL97 XX 4 XX2201 E10 LL90
    Worksheet: Sheet1

    sachin483 https://eileenslounge.com/viewtopic....306780#p306780
    i have postion code and reporting postion and in 2 column but i want the format of reporting one below another ie :- 4 level will report to 3 and 3 level report to 2 and 2 level will report to 1 if any level is not there then create blank level for upper postion example in attached File



    snb @ https://eileenslounge.com/viewtopic....306884#p306884
    The crux in the question
    Change the order of items from 1,2,3,3,3,4,4,4,4,4,4,4,4,4
    to inserting the '4' items after the '3' item it belongs to (where cells(n,3) matches cells(y,2))
    Resulting order: 1,2,3,4,4,4,3,4,4,4,3,4,4,4


    Alan, a few hours later https://excelfox.com/forum/showthrea...ll=1#post19938
    Change this
    1,2, 3 , 3 , 3 , 4 , 4 , 4 , 4, 4 , 4 , 4 . 4 , 4 , 4 , 4 , 4
    To this
    1,2, 3 , 4 , 4 . 4 , 4 , 3 , 4 , 4 , 4 , 4 , 4 , 3 , 4 , 4 , 4

    ' or


    Change this
    1
    2
    3
    3
    3
    4
    4
    4
    4
    4
    4
    4
    4
    4
    4
    4
    4
    To this
    1
    2
    3
    4
    4
    4
    4
    3
    4
    4
    4
    4
    4
    3
    4
    4
    4

  4. #534
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,466
    Rep Power
    10
    _____ Workbook: report.xls ( Using Excel 2007 32 bit )
    Row\Col A B C D E F I J K L M
    1 DATA REQUIRE
    2 DIVISION POSITION POSITION REPORTING LEVEL_NO empno code DIVISION LEVEL_NO POSITION empno code
    3 XX OZ00301 INDOL 1 E1 LL81 XX 1 OZ00301 E1 LL81
    4 XX LR0201 OZ00301 2 E2 LL82 XX 2 LR0201 E2 LL82
    5 XX LA0101 LR0201 3 E3 LL83 XX 3 LA0101 E3 LL83
    6 XX LA0201 LR0201 3 E4 LL84 XX 4 XX0101 E11 LL91
    7 XX LA0701 LR0201 3 E5 LL85 XX 4 XX0102 E12 LL92
    8 XX XX0502 LA0201 4 E6 LL86 XX 4 XX0103 E13 LL93
    9 XX XX0601 LA0201 4 E7 LL87 XX 4 XX0104 E14 LL94
    10 XX XX1901 LA0201 4 E8 LL88 XX 3 LA0201 E4 LL84
    11 XX XX2101 LA0201 4 E9 LL89 XX 4 XX0501 E17 LL97
    12 XX XX2201 LA0701 4 E10 LL90 XX 4 XX0502 E6 LL86
    13 XX XX0101 LA0101 4 E11 LL91 XX 4 XX0601 E7 LL87
    14 XX XX0102 LA0101 4 E12 LL92 XX 4 XX1901 E8 LL88
    15 XX XX0103 LA0101 4 E13 LL93 XX 4 XX2101 E9 LL89
    16 XX XX0104 LA0101 4 E14 LL94 XX 3 LA0701 E5 LL85
    17 XX XX0201 LA0701 4 E15 LL95 XX 4 XX0201 E15 LL95
    18 XX XX0301 LA0701 4 E16 LL96 XX 4 XX0301 E16 LL96
    19 XX XX0501 LA0201 4 E17 LL97 XX 4 XX2201 E10 LL90
    Worksheet: Sheet1





    Change this
    1,2, 3 , 3 , 3 , 4 , 4 , 4 , 4, 4 , 4 , 4 . 4 , 4 , 4 , 4 , 4
    To this
    1,2, 3 , 4 , 4 . 4 , 4 , 3 , 4 , 4 , 4 , 4 , 4 , 3 , 4 , 4 , 4

    ' or


    Change this
    1
    2
    3
    3
    3
    4
    4
    4
    4
    4
    4
    4
    4
    4
    4
    4
    4
    To this
    1
    2
    3
    4
    4
    4
    4
    3
    4
    4
    4
    4
    4
    3
    4
    4
    4

  5. #535
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,466
    Rep Power
    10
    Some notes for this main forum post
    https://eileenslounge.com/viewtopic.php?f=27&t=39588
    This uses something quite smart stumbled across here
    https://eileenslounge.com/viewtopic....266691#p266691

    If we have a 1 D array of arrays , like form example { {"a", "b"} , { "c", "d" } } , then strangely it acts in our famous App Index Rws() Clms() Magic code line just as if it was an array like this
    {"a", "b"
    "c", "d" }


    Strange , but true.

    So in Hans macro from here,
    http://www.eileenslounge.com/viewtop...306785#p306785
    , or rather the modified one from here ,
    http://www.eileenslounge.com/viewtop...306880#p306880
    , instead of pasting a 1 D array out each time, so pasting out a line each time, we add that array to an array of arrays, then finally paste out that final array using the App Index Rws() Clms() Magic code line.

    Effectively we are doing like this

    Code:
    Sub WonDeeArrayOfArrays() ' https://eileenslounge.com/viewtopic.php?p=266691#p266691
    Dim arr1D(1 To 2) As Variant
     Let arr1D(1) = Array("a", "b")
     Let arr1D(2) = Array("c", "d")
    Dim arrOut() As Variant
     Let arrOut() = Application.Index(arr1D(), Evaluate("=ROW(1:2)"), Array(1, 2))
     Let arrOut() = Application.Index(arr1D(), Evaluate("=ROW(1:2)"), Evaluate("=COLUMN(A:B)"))
    End Sub







    Code:
    Option Explicit
    Const SourceDivCol = 1
    Const SourcePosCol = 2
    Const SourceRepCol = 3
    Const SourceLevCol = 4
    Const SourceEmpCol = 5
    Const SourceCodCol = 6
    Const TargetDivCol = 15
    Const TargetLevCol = 16
    Const TargetPosCol = 17
    Const TargetEmpCol = 18
    Const TargetCodCol = 19
    Dim SourceRow As Long
    Dim TargetRow As Long
    Dim Cnt As Long
    Dim WunDeeArrayOfArrays() As Variant
    
    
    
    Sub CreateReportHansAlan2() '
     ReDim WunDeeArrayOfArrays(1 To Cells(1).CurrentRegion.Rows.Count - 2)
        Dim Boss As Range
        Dim Adr As String
        Dim Pos As String
        Application.ScreenUpdating = False
        TargetRow = 2
        Set Boss = Columns(SourceLevCol).Find(What:=1, LookAt:=xlWhole)
        Adr = Boss.Address
        Do
            SourceRow = Boss.Row
            TargetRow = TargetRow + 1
         Let Cnt = Cnt + 1: Let WunDeeArrayOfArrays(Cnt) = Application.Index(Cells, SourceRow, Array(SourceDivCol, SourceLevCol, SourcePosCol, SourceEmpCol, SourceCodCol))
    '     Let Range("O" & TargetRow & ":S" & TargetRow & "").Value2 = Application.Index(Cells, SourceRow, Array(1, 4, 2, 5, 6))
    '     Let Range("O" & TargetRow & ":S" & TargetRow & "").Value2 = Application.Index(Cells, SourceRow, Array(SourceDivCol, SourceLevCol, SourcePosCol, SourceEmpCol, SourceCodCol))
    '        Cells(TargetRow, TargetDivCol).Value = Cells(SourceRow, SourceDivCol).Value
    '        Cells(TargetRow, TargetLevCol).Value = Cells(SourceRow, SourceLevCol).Value
    '        Cells(TargetRow, TargetPosCol).Value = Cells(SourceRow, SourcePosCol).Value
    '        Cells(TargetRow, TargetEmpCol).Value = Cells(SourceRow, SourceEmpCol).Value
    '        Cells(TargetRow, TargetCodCol).Value = Cells(SourceRow, SourceCodCol).Value
            Pos = Cells(SourceRow, SourcePosCol).Value
            Call AddKids(Pos)
            Set Boss = Columns(SourceLevCol).Find(What:=1, After:=Boss, LookAt:=xlWhole)
            If Boss Is Nothing Then Exit Do
        Loop Until Boss.Address = Adr
        Application.ScreenUpdating = True
     
     Let Range("O3").Resize(Cells(1).CurrentRegion.Rows.Count - 2, 5).Value2 = Application.Index(WunDeeArrayOfArrays, Evaluate("=ROW(1:" & Cells(1).CurrentRegion.Rows.Count - 2 & ")"), Evaluate("=COLUMN(A:E)"))
    End Sub
    
    Sub AddKids(BossPos As String) '
        Dim Child As Range
        Dim Adr As String
        Dim Pos As String
        Set Child = Columns(SourceRepCol).Find(What:=BossPos, LookAt:=xlWhole)
        If Child Is Nothing Then Exit Sub
        Adr = Child.Address
        Do
            SourceRow = Child.Row
            TargetRow = TargetRow + 1
         Let Cnt = Cnt + 1: Let WunDeeArrayOfArrays(Cnt) = Application.Index(Cells, SourceRow, Array(SourceDivCol, SourceLevCol, SourcePosCol, SourceEmpCol, SourceCodCol))
    '     Let Range("O" & TargetRow & ":S" & TargetRow & "").Value2 = Application.Index(Cells, SourceRow, Array(SourceDivCol, SourceLevCol, SourcePosCol, SourceEmpCol, SourceCodCol))
    '        Cells(TargetRow, TargetDivCol).Value = Cells(SourceRow, SourceDivCol).Value
    '        Cells(TargetRow, TargetLevCol).Value = Cells(SourceRow, SourceLevCol).Value
    '        Cells(TargetRow, TargetPosCol).Value = Cells(SourceRow, SourcePosCol).Value
    '        Cells(TargetRow, TargetEmpCol).Value = Cells(SourceRow, SourceEmpCol).Value
    '        Cells(TargetRow, TargetCodCol).Value = Cells(SourceRow, SourceCodCol).Value
            Pos = Cells(SourceRow, SourcePosCol).Value
            Call AddKids(Pos)
            Set Child = Columns(SourceRepCol).Find(What:=BossPos, After:=Child, LookAt:=xlWhole)
            If Child Is Nothing Then Exit Do
        Loop Until Child.Address = Adr
    End Sub























    Ref
    https://eileenslounge.com/viewtopic....266691#p266691
    https://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html#post4571172
    https://www.excelforum.com/tips-and-tutorials/758402-vba-working-with-areas-within-2d-arrays.html#post5408376
    https://www.excelforum.com/excel-programming-vba-macros/1328703-copy-1-dim-array-to-and-2-dim-array.html
    http://www.eileenslounge.com/viewtopic.php?p=271035#p271035
    https://www.ozgrid.com/forum/index.php?thread/1227920-slicing-a-2d-array/&postID=1239241#post1239241
    https://eileenslounge.com/viewtopic.php?p=274367&sid=6b84ff6917c71e849aaeaa281d06fc31#p27436
    https://eileenslounge.com/viewtopic.php?f=30&t=34217&p=265384#p265384

    Ref
    https://www.excelforum.com/excel-new...ml#post4571172
    https://www.excelforum.com/tips-and-...ml#post5408376
    https://www.excelforum.com/excel-pro...dim-array.html
    http://www.eileenslounge.com/viewtop...271035#p271035
    https://www.ozgrid.com/forum/index.p...41#post1239241 , https://eileenslounge.com/viewtopic....d06fc31#p27436
    https://eileenslounge.com/viewtopic....265384#p265384
    https://eileenslounge.com/viewtopic....266691#p266691

  6. #536
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,466
    Rep Power
    10
    I missed the point, ( possibly ), with the OPs original data, saying he had like this
    1,2, 3 , 3 , 3 , 4 , 4 , 4 , 4, 4 , 4 , 4 . 4 , 4 , 4 , 4 , 4
    , but wanted this:
    1,2, 3 , 4 , 4 . 4 , 4 , 3 , 4 , 4 , 4 , 4 , 4 , 3 , 4 , 4 , 4
    I missed the point ( possibly ) that there could be more than one level 2 and that maybe the levels could go on a lot further above level 4. Maybe that additional information is obvious to most people? It is not to me. The more flexible open ended requirement would explain all the recursioning, explorer tree view type things discussed.

    Never mind.. , a restricted scenario could still be useful to investigate for another solution.
    Restricted solution
    Restrictions:

    One Big Boss , level 1
    , a deputy who does all his work, Level 2
    , or rather organises the line managers, level 3
    , who in turn have all the workers organised beneath them, level 4

    Macro Sub AlanAlmostGotThePointAgain()
    Rem 0 I bring the data into an array in one go, to do some things a bit more efficiently, but this solution is still not a reduce the interaction with the workbook to 2 instances: reading data, writing the result
    Rem 1 Based on the restrictions, this simply adds the first few lines in the final data for output, in the re ordered column order.

    Rem 2a
    A basic formula is used in an “Evaluate Range” type VBA code line. It’s based on a basic spreadsheet formula of the type
    =IF(C5:C19=$B$4;ROW(B5:B19);0)
    In words, what this is doing is:
    For the level 2, the one position 2, LR0201 , is searched for in the POSITION REPORTING column C. The result is returned in the form of spreadsheet row number, and form the test data will look like this


    5
    6
    7
    0
    0
    0
    0
    0
    0
    0
    0
    0
    0
    0
    0


    In Rem 3 , this information gives us the count of level 3s, Lvl3s , and then in the first bit of Rem 4, Rem4a , we use this information to from the input array, the information at the correct position in the final output data array , ( using the running count position variable, Dw to give the required position in the final output data array )

    Rem 4
    This section is a typical inner loop within an outer loop type situation. Rem 4a in the outer loop section deals with the level 3 positions in the final output array, - at each of ( three in the sample data, ) level 3s we have a similar “Evaluate Range” formula to that used previously, - in this case, the formula in Rem 4b , based on this sort of spreadsheet formula,
    =IF(C8:C19=$B$5;ROW(C8:C19);0)
    , is used to give us the row within the input data to find each set of level 4s reporting to any particular level 3.
    For example, on the case of the first outer loop, ( CntInds3 = 1 ) we look for a POSITION REPORTING of LA0101 , and obtain a spread of results of the following form from that single line evaluate range type formula


    0
    0
    0
    0
    0
    13
    14
    15
    16
    0
    0
    0


    The inner loop of section Rem 4c deals with giving us the data in the output data array for those ) in the example data, 4 for the first outer loop, ) found level 4s reporting to the level 3 being considered in the outer loop.


    Here is a full coding with some extra 'comment notes

    Code:
    '
    Sub AlanAlmostGotThePointAgain() '        https://eileenslounge.com/viewtopic.php?p=306916&sid=baf68db6f023ebc9d65767c7abf9e19d#p306916
    Rem 0 worksheets data info
    Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets.Item(1)
    Dim arrIn() As Variant: Let arrIn() = Ws1.Range("A1").CurrentRegion.Value2                          '    Ws1.Range("A1").CurrentRegion.Resize(Ws1.Range("A1").CurrentRegion.Rows.Count + 1).Value2
    Dim arr1DArrays() As Variant ' https://eileenslounge.com/viewtopic.php?p=306912#p306912   https://excelfox.com/forum/showthread.php/2837-Appendix-Thread-App-Index-Rws()-Clms()-Majic-code-line-Codings-for-other-Threads-Tables-etc-)?p=19940&viewfull=1#post19940    https://excelfox.com/forum/showthread.php/2837-Appendix-Thread-App-Index-Rws()-Clms()-Majic-code-line-Codings-for-other-Threads-Tables-etc-)/page54#post19940
     ReDim arr1DArrays(1 To UBound(arrIn(), 1)) '                                                                         ReDim arr1DArrays(1 To UBound(arrIn(), 1) - 1)                                                    ' Each element will be a row in the final output - see links in last line
    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))     '   Ws1.Range("A1:E1").Value2  '
     Let arr1DArrays(2) = Application.Index(Ws1.Cells, 2, Array(1, 4, 2, 5, 6))
     Let arr1DArrays(3) = Application.Index(Ws1.Cells, 3, Array(1, 4, 2, 5, 6))
     Let arr1DArrays(4) = Application.Index(Ws1.Cells, 4, Array(1, 4, 2, 5, 6))
    Rem 2a
    Dim Dw As Long: Let Dw = 4 ' The main data row for output.  Dw is like a running count keeping note of the next line to add output data to
                                                                                                                         'Dim Lvl As Long: Let Lvl = 2
    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
                                                                                                                                    '    If arrInds3(Inds3, 1) = 0 Then Let Dw = Dw + Inds3 + 2: Dim Lvl3s As Long: Let Lvl3s = Inds3 - 1: Exit For
                                                                                                                                    ' Let arr1DArrays(arrInds3(Inds3, 1) - 2) = Application.Index(Ws1.Cells, arrInds3(Inds3, 1), Array(1, 4, 2, 5, 6))
        Next Inds3
    Rem 4
    Rem 4a
    '  now we want to investigate all the level 4s reporting to all the level 3s
    Dim CntInds3 As Long ' 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
            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
    





    Final results and simplified coding in next posts

  7. #537
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,466
    Rep Power
    10
    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
    Worksheet: Sheet1
    Attached Files Attached Files

  8. #538
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,466
    Rep Power
    10
    We note a slight difference in order presented in the final results for the level 4s,
    https://excelfox.com/forum/showthrea...ll=1#post19943
    https://bit.ly/3LpFarN
    , when compared with results from the other solutions so far given
    https://excelfox.com/forum/showthrea...ll=1#post19944
    https://bit.ly/3L5bLBV

    - This sort of difference is commonly seen when comparing explorer / recursioning type solutions with simpler looping ones which build up the results one line after the other - recursioning type solutions go up and down the explorer tree view structure thingy and so often order the final results a bit differently.






    _____ Workbook: report.xls ( Using Excel 2007 32 bit )
    Row\Col I J K L M AE AF AG AH AI
    1 REQUIRE DATA
    2 DIVISION LEVEL_NO POSITION empno code DIVISION LEVEL_NO POSITION empno code
    3 XX 1 OZ00301 E1 LL81 XX 1 OZ00301 E1 LL81
    4 XX 2 LR0201 E2 LL82 XX 2 LR0201 E2 LL82
    5 XX 3 LA0101 E3 LL83 XX 3 LA0101 E3 LL83
    6 XX 4 XX0101 E11 LL91 XX 4 XX0101 E11 LL91
    7 XX 4 XX0102 E12 LL92 XX 4 XX0102 E12 LL92
    8 XX 4 XX0103 E13 LL93 XX 4 XX0103 E13 LL93
    9 XX 4 XX0104 E14 LL94 XX 4 XX0104 E14 LL94
    10 XX 3 LA0201 E4 LL84 XX 3 LA0201 E4 LL84
    11 XX 4 XX0501 E17 LL97 XX 4 XX0502 E6 LL86
    12 XX 4 XX0502 E6 LL86 XX 4 XX0601 E7 LL87
    13 XX 4 XX0601 E7 LL87 XX 4 XX1901 E8 LL88
    14 XX 4 XX1901 E8 LL88 XX 4 XX2101 E9 LL89
    15 XX 4 XX2101 E9 LL89 XX 4 XX0501 E17 LL97
    16 XX 3 LA0701 E5 LL85 XX 3 LA0701 E5 LL85
    17 XX 4 XX0201 E15 LL95 XX 4 XX2201 E10 LL90
    18 XX 4 XX0301 E16 LL96 XX 4 XX0201 E15 LL95
    19 XX 4 XX2201 E10 LL90 XX 4 XX0301 E16 LL96
    Worksheet: Sheet1

Similar Threads

  1. Replies: 185
    Last Post: 05-22-2024, 10:02 PM
  2. Replies: 539
    Last Post: 04-24-2023, 04:23 PM
  3. Appendix Thread. 3 *
    By DocAElstein in forum Test Area
    Replies: 540
    Last Post: 04-24-2023, 04:23 PM
  4. Replies: 293
    Last Post: 09-24-2020, 01:53 AM
  5. Appendix Thread. Diet Protokol Coding Adaptions
    By DocAElstein in forum Test Area
    Replies: 6
    Last Post: 09-05-2019, 10:45 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •