VBA Excel get a value from parent to all it's children

Question

I am looking to make a VBA code that would go through an item hierarchy list and copy the certain value from parent row part to all of it's child row parts. As you can see on the image below is that I have a hierarchy list in column "J" and subgroup value in column "C". So the goal is to get VBA code to copy the uppermost items "Subgroup" value to all it's children parts. I coloured the blocks of different hierarchy branches: 1.1 , 1.2 and 1.3.

So you can see that "001" from row 1.1 should be copied to all it's subparts which are always delimited by ".", for example, 1.1.1 is a first item in 1.1 and that in turn is a first part in parent part 1

My approach to this problem would be to go from the bottom of the whole list and to go up iteration by iteration till I get to the uppermost item in the hierarchy branch and then take "Subgroup" value of that uppermost item and copy it in the same column but on the first row from which the search started.

That means to find item 1.1.29 parent part, I need to exclude the right side+ delimiter "." to know what to look for. Which would be 1.1. Next I would repeat the action and exclude right side of the string with delimiter getting 1. As you can see in the example list, there's no ITEM NO with value 1 meaning that previous 1.1 was the uppermost part.

Now I take the "subgroup" value from the row with 1.1, which in this case is "001" and copy it to the same column cell to the very first row from which the search started which was 1.1.29.

And just like that I would need to loop through every row in the list.

In the example list yellow block is expected to have "001", red to have "002" and green "026".

What I have now is:

Sub Recalculate()

'Declare variables
 
Dim LastRow As Long
LastRow = Cells(Rows.Count, "E").End(xlUp).Row

'Main script

For i = 2 To LastRow
current_index = Split(Cells(i, 10).Value, ".", , vbBinaryCompare)(0)
left_column = Cells(i, 3).Value
For j = current_index To LastRow
    nestled_index = Split(Cells(j, 10).Value, ".", , vbBinaryCompare)(0)
    If current_index = nestled_index Then
        Cells(j, 3).Value = left_column
        
    End If
Next j
Next i

End Sub

Which kinda does the job but often fails to do it correctly. As far as I understand is taht it doesn't look for an exact match of value being searched. Say, I'm looking for 2.2, but there's an item 1.1.2 and it counts it as a match since the string does contain the value searched.

Same needed result could be achieved by going down the list and searching one level up the list. to get the subgroup value.

Say I start from 1.1.1 which means I need a subgroup value from 1.1 which already is correct and I can copy it to the row 1.1.1 Next say we are working with 1.1.1.1 meaning we need to look for 1.1.1 which by now already has gotten a correct subgroup value. And that continues throughout the whole list.

Would someone assist me in writing this code correctly to get a desired result, please?

Answer 1

This should do what you want. It gets the first two elements of an array created from splitting on "." and checks that value against the stored parent number, if it doesn't match then it becomes the new parent.

    Dim i As Long
    Dim lr As Long
    Dim subgroup As String
    Dim parent As String
    
    With Sheet1
        lr = .Cells(.Rows.Count, 3).End(xlUp).Row
        For i = 2 To lr
            If i = 2 Then
                subgroup = .Cells(i, 3).Value
                parent = Split(.Cells(i, 10).Value, ".")(0) & "." & Split(.Cells(i, 10).Value, ".")(1)
            ElseIf Split(.Cells(i, 10).Value, ".")(0) & "." & Split(.Cells(i, 10).Value, ".")(1) <> parent Then
                subgroup = .Cells(i, 3).Value
                parent = Split(.Cells(i, 10).Value, ".")(0) & "." & Split(.Cells(i, 10).Value, ".")(1)
            Else
                .Cells(i, 3).Value = subgroup
            End If
        Next i
    End With

If there is a possibility that there are no "." in a cell in column J you'll need to do an instr() to check for it.

This should accomplish that.

Sub t()
    Dim i As Long
    Dim lr As Long
    Dim subgroup As String
    Dim parent As String
    dim delrng as range
    With Sheet1
        lr = .Cells(.Rows.Count, 3).End(xlUp).Row
        For i = 2 To lr
            If i = 2 Then
                subgroup = .Cells(i, 3).Value
                parent = getParent(.Cells(i, 10))
            ElseIf Left(.Cells(i, 10), Len(parent)) <> parent Then
                subgroup = .Cells(i, 3).Value
                parent = getParent(.Cells(i, 10))
            Else
                'If you want to delete
                if delrng is nothing then
                    set delrng = .rows(i).entirerow
                else
                    set delrng = union(delrng, .rows(i).entirerow)
                end if
                .Cells(i, 3).Value = subgroup 
            End If
        Next i
    End With
    delrng.delete
End Sub

Function getParent(cell As Range) As String
    If Not InStr(1, cell.Value, ".") Then
        getParent = cell.Value
    Else
        getParent = Split(cell, ".")(0) & "." & Split(cell.Value, ".")(1)
    End If
End Function