Do until inside a for loop stepping backwards?

Question

I'm trying to write some code for a spreadsheet to calculate if items within a Bill of Materials (BoM) are a child of a purchased assembly or not. I'll try and explain in more detail.

Basically my spreadsheet has many columns, but only 2 are needed to calculate from. For simplicity I'll just say these are Columns A & B and the output from the VBA is put in Column C.

Column A contains the BoM level - This always starts at Level 0 and children of this level are level 1, and children of level 1 are level 2 and so on. Currently from all the BoMs I have created, level 10 has been 'deepest' it goes, but it isn't impossible that this could increase.

Column B contains the Assembly status - The only value I'm interested in this column is "P" for purchased.

Due to the various headings in my spreadsheet the data starts at Row 12 and as this is the Top Level I can always mark this as "TL" in Column C.

Now the bit I am struggling with. For each row from 13 onwards (this could easily extend to 100,000 rows and beyond!) I need to look at Column A (BoM level) and then look upwards to find the level below until I either find a level that is purchased ("P" in Column B) or reach BoM level 0.

Hopefully this table will help

Column A	Column B	Column c
0	IH	TL
1	IH	FALSE
2		FALSE
2		FALSE
1	P	FALSE
2	P	TRUE
3		TRUE
3		TRUE

Whilst thinking of how to automate this issue, I thought I could use a For loop with a nested Select Case followed by a nested For loop (with Step -1).

The first For loop start at the top and look down to the last row, at each row it looks at the BoM Level and based on the this value a Select Case is used to run a For loop (Step -1) to start looking back up the rows.

The problem I can see is I would need to have a Case for each possible BoM level (the maximum total levels possible is 99)

Extract of code so far (only going to Case 3):

Sub Purch_Child_Formula()   'ADD CHILD OF PURCHASED ASSY FORMULA
Dim AssyStatus As Double
Dim ChildPurchStatus As Double
Dim CurrentBomLevel As Integer
Dim X As Long

Last_Row = ActiveSheet.Range("A" & rows.Count).End(xlUp).Row

For ChildPurchStatus = 13 To Last_Row
    CurrentBomLevel = Cells(ChildPurchStatus, 1).Value
    
        Select Case CurrentBomLevel
        
        Case 1
            For X = ChildPurchStatus To 13 Step -1
            If Cells(X - 1, 1).Value = CurrentBomLevel Then
            Exit For
            ElseIf Cells(X - 1, 1).Value = (CurrentBomLevel - 1) And Cells(X - 1, 2).Value = "P" Then
                Cells(X, 3).Value = "TRUE"
            Else
                Cells(X, 3).Value = "FALSE"
            End If
            Next X
        Case 2
            For X = ChildPurchStatus To 13 Step -1
            If Cells(X - 1, 1).Value = CurrentBomLevel Then
            Exit For
            ElseIf Cells(X - 1, 1).Value = (CurrentBomLevel - 1) And Cells(X - 1, 2).Value = "P" Then
                Cells(X, 3).Value = "TRUE"
            ElseIf Cells(X - 1, 1).Value = (CurrentBomLevel - 2) And Cells(X - 1, 2).Value = "P" Then
                Cells(X, 3).Value = "TRUE"
            Else
                Cells(X, 3).Value = "FALSE"
            End If
            Next X
        Case 3
            For X = ChildPurchStatus To 13 Step -1
            If Cells(X - 1, 1).Value = CurrentBomLevel Then
            Exit For
            ElseIf Cells(X - 1, 1).Value = (CurrentBomLevel - 1) And Cells(X - 1, 2).Value = "P" Then
                Cells(X, 3).Value = "TRUE"
            ElseIf Cells(X - 1, 1).Value = (CurrentBomLevel - 2) And Cells(X - 1, 2).Value = "P" Then
                Cells(X, 3).Value = "TRUE"
            ElseIf Cells(X - 1, 1).Value = (CurrentBomLevel - 3) And Cells(X - 1, 2).Value = "P" Then
                Cells(X, 3).Value = "TRUE"
            Else
                Cells(X, 3).Value = "FALSE"
            End If
            Next X
        Case 4
            
        Case 5
            
        Case 6
            
        Case 7
            
        Case 8
            
        Case 9
            
        Case 10
        
        End Select
            
Next ChildPurchStatus
    
End Sub

This starts to work, but does go wrong before reaching a BoM Level of 4.

So now I'm thinking that perhaps I should use an initial for loop to down the rows, followed but another for loop looking back up the data, but this for loop should continue until it finds the criteria "P" in Column 2 - and we've arrived at an Until loop. Is this possible? (It may be evident that coding is not part of my normal job!)

Sorry for the very wordy post, but my scenario seems to unique as some searching online hasn't helped so far.

Hopefully there is enough information in this post. I will add any other details requested.

Answer 1

• Using Dictionary object to store the status of upper BoM.

Option Explicit
Sub Demo()
    Dim i As Long, j As Long
    Dim Sht1 As Worksheet
    Dim arrRes, rngRes As Range
    Dim objDic As Object, sKey As Long
    Set Sht1 = Sheets("Sheet1") ' Modify as needed
    Set rngRes = Sht1.Range("A1").CurrentRegion ' Modify as needed
    arrRes = rngRes.Value
    Set objDic = CreateObject("scripting.dictionary")
    ' Loop through data
    For i = LBound(arrRes) To UBound(arrRes)
        sKey = CLng(arrRes(i, 1))
        If Not objDic.exists(sKey) Or UCase(arrRes(i, 2)) = "P" Then
            objDic(sKey) = UCase(arrRes(i, 2))
        End If
        If sKey > 0 Then
            arrRes(i, 3) = False
            ' Loop through up BoM
            For j = sKey - 1 To 0 Step -1
                If objDic(j) = "P" Then
                    arrRes(i, 3) = True
                    Exit For
                End If
            Next
        End If
    Next i
    ' Update data on sheet
    rngRes.Value = arrRes
End Sub

Answer 2

You could just do this with a formula.

=COUNTIFS(RC3:OFFSET(RC1,MAX(FILTER(ROW(R1C1:RC1),R1C1:RC1=0))-ROW(RC),2),"=P")>0

In A1 mode, my cell D1 has this:

=COUNTIFS($C1:OFFSET($A1,MAX(FILTER(ROW($A$1:$A1),$A$1:$A1=0))-ROW(D1),2),"=P")>0

Answer 3

The Boolean solution

As discussed before, I use a boolean and to keep track of which BoM lvl is the lowest, I have one extra variable for that as well:

Sub Purch_Child_Formula()   'ADD CHILD OF PURCHASED ASSY FORMULA
    Dim lRow As Long, i As Long, bomLvl As Long
    Dim ws As Worksheet
    Dim pCheck As Boolean
    
    Set ws = ActiveSheet
    lRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
    
    If lRow < 13 Then
        MsgBox "Not enough rows to check"
        Exit Sub
    End If
    
    Dim arr, arrPr
    arr = ws.Range("A13:B" & lRow).Value 'from your example
    ReDim arrPr(1 To UBound(arr, 1), 1 To 1)
    
    For i = 1 To UBound(arr, 1)
        If arr(i, 1) = 0 Then 'resetting
            pCheck = False
            bomLvl = 0
        End If
        If arr(i, 2) = "P" Then
            If Not pCheck Then
                pCheck = True
                bomLvl = arr(i, 1)
            End If
            If bomLvl > arr(i, 1) Then bomLvl = arr(i, 1)
        End If
        arrPr(i, 1) = pCheck And bomLvl < arr(i, 1)
        'there is a P and its BoM is lower than current one ... or not
    Next i
    
    ws.Range("C13:C" & lRow).Value = arrPr 'print everything at once
End Sub

Let me know if the following result is wrong:

• 0 resets everything
• lvl 3 has P -> lvl 4 and above are True
• lvl 2 has P so now lvl 3 and above are True