VBA macro to extract parent part# for each part from a multi-level list

[niranjanbt]

Dear All,

I am trying to create a VBA macro which can extract parent part# for each part from a multi-level list.

In the example shown below:
Column-A = Muilti-level list AKA item#
Column-B = Part#
Column-C/D/E = Column-A split at dot delimiters
Column-F = Required output (parent part#) from the macro. Hope it is self-explanatory as to what is the parent part#

Any help to develop this macro is much appreciated!

Thanks,
NT

 

[tonyyy]

NT,

In future, please post your data as data rather than a pic. Please see my signature regarding how to post your Excel data.

That said, you might consider the following...

Sub ParentPartNo_1025580()
Dim r As Range, Lengthh As Long, i As Long
For Each r In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    i = 1
    Lengthh = Len(r)
    Select Case Lengthh
        Case 1
            r.Offset(0, 5).Value = "-"
        Case 3
            Do
                If Len(Cells(r.Row - i, 1)) = 1 Then
                    r.Offset(0, 5).Value = Cells(r.Row - i, 2).Value
                    GoTo Nexxt
                End If
                i = i + 1
            Loop
        Case 5
            Do
                If Len(Cells(r.Row - i, 1)) = 3 Then
                    r.Offset(0, 5).Value = Cells(r.Row - i, 2).Value
                    GoTo Nexxt
                End If
                i = i + 1
            Loop
    End Select
Nexxt:
Next r
End Sub

Cheers,

tonyyy

 

[tonyyy]

Another version, a bit more compact and allows for additional levels in part numbers (eg, 3.1.1.1)...

Sub ParentPartNo_1025580r2()
Dim r As Range, Lengthh As Long, i As Long
For Each r In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    i = 1
    Lengthh = Len(r)
    If Lengthh = 1 Then
        r.Offset(0, 5).Value = "-"
        GoTo Nexxt
    End If
    Do
        If Len(Cells(r.Row - i, 1)) = Lengthh - 2 Then
            r.Offset(0, 5).Value = Cells(r.Row - i, 2).Value
            GoTo Nexxt
        End If
        i = i + 1
    Loop
Nexxt:
Next r
End Sub