How to generate an alphanumeric tree changes with criteria? - excel

Question

I'm working on excel sheet template used for SAP System and I have 2 columns looks like below:
Column C Column E
Level Element Code
3 ABCD.01.01.01
4 ABCD.01.01.01.01
4 ABCD.01.01.01.02
4 ABCD.01.01.01.03
3 ABCD.01.01.02
4 ABCD.01.01.02.01 'I Want to Restart Numbering Here
4 ABCD.01.01.02.02
4 ABCD.01.01.02.03
I succeeded in level 3 to be automated in the whole sheet by Macro as below
Sub AutoNumber3()
Dim Rng, C As Range
Dim Lrow As Long
Dim i As Integer
Lrow = Cells(Rows.Count, 1).End(xlUp).Row
Set Rng = Worksheets("Union").Range("C2:C" & Lrow)
i = 1
For Each C In Rng.Cells
If C.Value = 3 Then
For i = 1 To i Step 1
C.Offset(0, 2).Value = "ABCD.01.01." & i
Next i
End If
Next C
End Sub
and I used the same for level 4 as below
Sub AutoNumber4()
Dim Rng, C As Range
Dim Lrow As Long
Dim i As Integer
Lrow = Cells(Rows.Count, 1).End(xlUp).Row
Set Rng = Worksheets("Union").Range("C2:C" & Lrow)
i = 1
For Each C In Rng.Cells
If C.Value = 4 Then
For i = 1 To i Step 1
C.Offset(0, 2).Value = "ABCD.01.01.01" & i
Next i
End If
Next C
End sub
I want to Restart the numbering of level 4 from 1 each time the cells values in the level column = 3 by using Do Until the next C.Value = 3, I = 1 But I can not put it correctly in the Autonumber4 procedure
Your help is highly appreciated since this sheet may reach to 50000 or 100000 rows which is impossible to fill them manually
Thanks, Regards
Moheb Labib

Answer 1

Try this
Sub AutoNumber()
Dim rngLevels As Range, cl As Range
Dim lLastRow As Long, i As Long
Dim sElemCode As String
Dim vLevelsCounter() As Long
With ThisWorkbook.Sheets("Union")
lLastRow = Evaluate("=COUNTA(" & .Name & "!C:C)")
lLastRow = WorksheetFunction.Max(lLastRow, .Cells(Rows.count, "C").End(xlUp).Row)
Set rngLevels = .Range("C2:C" & lLastRow)
End With
For Each cl In rngLevels.Cells
' Uncomment "If" to use it on filtered data only
'If Not cl.EntireRow.Hidden Then
UpdateLevelsCounters vLevelsCounter, cl.Value
sElemCode = "ABCD"
For i = 1 To cl.Value
sElemCode = sElemCode & "." & Format(vLevelsCounter(i), "00")
Next i
cl.Offset(0, 2).Value = sElemCode
'End If
Next cl
End Sub
Function UpdateLevelsCounters(ByRef arr() As Long, lLevel As Long)
If lLevel < 1 Then Exit Function
Dim i As Long
ReDim Preserve arr(1 To lLevel)
For i = LBound(arr) To lLevel - 1
If arr(i) = 0 Then arr(i) = 1
Next i
arr(lLevel) = arr(lLevel) + 1
End Function
This should work for levels other than 3 and 4 as well (I hope)

Answer 2

You've not specified if your count will be always of two digits or not, and if it can be something like 01.20.99.99, but This formula can lead you in the good way (not tested with 100000 records)
=IF(C2=3;"ABCD.01.01."&TEXT(COUNTIF($C$2:C2;C2);"00");INDIRECT("E"&SUMPRODUCT(MAX(--($C$2:C2=3)*ROW($C$2:C2))))&"."&TEXT(SUMPRODUCT(--($C$2:C2=4)*--(ROW($C$2:C2)>SUMPRODUCT(MAX(--($C$2:C2=3)*ROW($C$2:C2)))));"00"))
This is how it works:
A) First, we check if cell in colum C is a 3 or 4. In case is 3, we do ;"ABCD.01.01."&TEXT(COUNTIF($C$2:C2;C2);"00"); This will count how many times does the number 3 appear in range $C$2:C2 and will concatenate to string ABCD.01.01. The trick here is using $C$2:C2, because it makes a range dynamic (but it can overload calculus times)
B) If not 3, then we do a really complext part I'm going to try to explain. Also, we use the trick of dynamic range
SUMPRODUCT(MAX(--($C$2:C2=3)*ROW($C$2:C2)))) this part is used twice. It will get the last row number of the last 3 value in column C.
Example:ROW($C$2:C6) will get an array of just row numbers, like {2;3;4;5;6}. --($C$2:C6=3) will return an array of zero/one depending if cell equals/not equals to 3, something like {1;0;0;0;1}. ($C$2:C6=3)*ROW($C$2:C6)) will multiply both arrays, so we get {1;0;0;0;1}*{2;3;4;5;6}={2;0;0;0;6}. And with MAX we get max value from that array, That 6 means the last position of a 3 value.
We use INDIRECT combined with the number of step 1 to get the text inside the cell
SUMPRODUCT(--($C$2:C2=4)*--(ROW($C$2:C2)>SUMPRODUCT(MAX(--($C$2:C2=3)*ROW($C$2:C2)))));" Everything after the > is the same logic than step 1. It will return the row number of last cell containing a 3. Part SUMPRODUCT(--($C$2:C2=4)*--(ROW($C$2:C2) will just get row numbers of those cells containing a 4 value, and which row numbers are higher than value obtained in step 1. That way you make sure how to count the cells containing 4 values, between two cells containing 3 values.
We concatenate everything to form the final string.
TEXT functions are just used to force the calculation to be 2 digits.
You can use this manually, or you can insert the formula using VBA, drag down, and then converting everything into values (I would probably would do that). Something like this could work.
Sub Macro1()
Dim LR As Long
LR = Range("C" & Rows.Count).End(xlUp).Row 'last non blank row in column c
Range("E2").FormulaR1C1 = _
"=IF(RC[-2]=3,""ABCD.01.01.""&TEXT(COUNTIF(R2C3:RC[-2],RC[-2]),""00""),INDIRECT(""E""&SUMPRODUCT(MAX(--(R2C3:RC[-2]=3)*ROW(R2C3:RC[-2]))))&"".""&TEXT(SUMPRODUCT(--(R2C3:RC[-2]=4)*--(ROW(R2C3:RC[-2])>SUMPRODUCT(MAX(--(R2C3:RC[-2]=3)*ROW(R2C3:RC[-2]))))),""00""))"
Range("E2").AutoFill Destination:=Range("E2:E" & LR), Type:=xlFillDefault
Range("E2:E" & LR) = Range("E2:E" & LR).Value 'paste into values
End Sub
NOTE: Probably you will need to adapt this depending on the results (we do not know if the count of 3 or 4 values can have 3 or 4 digits, and so on).