Speed up parent child hierarchy macro

[sachin483]

i have macro for parent child hierarchy macro but i want to run the same for more than 20000 rows can it be speed up

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

Sub CreateReport()
    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
        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 AddChildren(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
End Sub

Sub AddChildren(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
        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 AddChildren(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

 

[DanteAmor]

if level no. is sorted from largest to small then it doesn't work

That is very simple to solve, just sort your data before running the macro.

The important thing is 2 points:
1. Improve speed.
2. That the macro works with the situation that you raised in your original post.

Undoubtedly the macro could fail if you change the setting, if you put the data in a different way, if you change the columns, if they start in another row, if you protect the sheet, in short, a number of possibilities that I could not know.

We would like you to comment on your original request:

i have macro for parent child hierarchy macro but i want to run the same for more than 20000 rows can it be speed up

Is the time faster with that amount of rows?

--------------
I hope to hear from you soon.
Respectfully
Dante Amor
--------------

 

[sachin483]

Thanks ,the speed is fast but where there are multiple division at level 1 2nd division level gets deleted ie:- YY level does not gets displayed

DATA
DIVISION	POSITION	POSITION REPORTING	LEVEL_NO	empno	code
XX	OZ00301	INDOL	1​	E1	LL81
YY	YZ00301	INDOT	1​	E1	YY81
XX	LR0201	OZ00301	2​	E2	LL82
YY	YR0201	OZ00301	2​	E2	YY82
XX	LA0101	LR0201	3​	E3	LL83
XX	LA0201	LR0201	3​	E4	LL84
XX	LA0701	LR0201	3​	E5	LL85
YY	YA0101	YR0201	3​	E3	YY83
YY	YA0201	YR0201	3​	E4	YY84
YY	YA0701	YR0201	3​	E5	YY85
XX	XX0502	LA0201	4​	E6	LL86
XX	XX0601	LA0201	4​	E7	LL87
XX	XX1901	LA0201	4​	E8	LL88
XX	XX2101	LA0201	4​	E9	LL89
XX	XX2201	LA0701	4​	E10	LL90
XX	XX0101	LA0101	4​	E11	LL91
XX	XX0102	LA0101	4​	E12	LL92
XX	XX0103	LA0101	4​	E13	LL93
XX	XX0104	LA0101	4​	E14	LL94
XX	XX0201	LA0701	4​	E15	LL95
XX	XX0301	LA0701	4​	E16	LL96
XX	XX0501	LA0201	4​	E17	LL97
YY	YY0502	YA0201	4​	E6	YY86
YY	YY0601	YA0201	4​	E7	YY87
YY	YY1901	YA0201	4​	E8	YY88
YY	YY2101	YA0201	4​	E9	YY89
YY	YY2201	YA0701	4​	E10	YY90
YY	YY0101	YA0101	4​	E11	YY91
YY	YY0102	YA0101	4​	E12	YY92
YY	YY0103	YA0101	4​	E13	YY93
YY	YY0104	YA0101	4​	E14	YY94
YY	YY0201	YA0701	4​	E15	YY95
YY	YY0301	YA0701	4​	E16	YY96
YY	YY0501	YA0201	4​	E17	YY97

 

[DanteAmor]

but where there are multiple division at level 1 2nd division level gets deleted

As I said there are several factors that I do not know, in my head I only conceive a structure with a level 1. I can't imagine a country with 2 presidents, a company with 2 directors, etc. But I guess this case is different, but you didn't mention it, and I can't develop something for cases that you didn't ask for and probably don't exist.

Please share a file with a more real case, if possible your 20,000 rows file, so that I can plan, design, develop and test a macro according to your real needs.


Or maybe someone else in the forum, already with all the requirements well defined, will help us with a code that works for you.