Excel VBA inconsistent behaviour while trying to implement a tree view - excel

Question

Sub myfunction()
Dim convert_i, convert_k As String
Dim i, j, k, l As Long
For i = 2 To 583
For k = i + 1 To 583
j = InStr(Range("F" & k).Text, Range("F" & i).Text)
If j > 0 Then
l = InStr(Range("F" & k).Text, " \ ")
If l > 1 Then
convert_i = Range("F" & i).Text & ""
convert_k = Range("F" & k).Text & ""
pos = InStrRev(convert_k, convert_i) - 1
Range("F" & k).Value = Right(convert_k, Len(convert_i) - pos)
Range("F" & k).Value = Range("F" & i).Text + Range("F" & k).Text
Else:
Range("F" & k).Value = Range("F" & i).Value + " \ " + Range("F" & k).Value
End If
End If
Next k
Next i
MsgBox ("Finished ")
End Sub
The code works for the most part however it's inconsistent and I'm baffled as to why. The desired result is like
CP \ CP01 \ CP0103
And through the document I think like at least a good 70 percent is of this format but I do not have the time to go trough remaining 30 percent manually. I would very much appreciate any help.
Please check images below:
The expected result:
enter image description here

Answer 1

Create a Tree
Adjust the values in the constants section.
Option Explicit
Sub createTree()
Const wsName As String = "Sheet1"
Const First As String = "F2"
Const len1 As Long = 2
Const len2 As Long = 4
Const Sep As String = " \ "
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim rg As Range
With wb.Worksheets(wsName).Range(First)
Dim lCell As Range
Set lCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
.Find("*", , xlFormulas, , , xlPrevious)
If lCell Is Nothing Then Exit Sub
Set rg = .Resize(lCell.Row - .Row + 1)
End With
Dim Data As Variant: Data = rg.Value ' assuming there is data in F3 at least
Dim sLen As Long: sLen = Len(Sep)
Dim tLen As Long: tLen = len1 + sLen + len2
Dim cString As String
Dim cPref1 As String
Dim cPref2 As String
Dim r As Long
For r = 1 To UBound(Data, 1)
cString = Trim(Data(r, 1))
Select Case Len(cString)
Case len1
cPref1 = cString
cPref2 = ""
Data(r, 1) = cString
Case len2
cPref2 = cPref1 & Sep & cString
Data(r, 1) = cPref2
Case Else
If Len(cPref2) = tLen Then
cPref2 = cPref2 & Sep & cString
Else
cPref2 = Left(cPref2, tLen) & Sep & cString
End If
Data(r, 1) = cPref2
End Select
Next r
rg.Value = Data
End Sub

Answer 2

Sub myfunction()
Dim convert_i, convert_k, last_part As String
Dim i, j, k, l As Long
For i = 2 To 583
For k = i + 1 To 583
j = InStr(Range("F" & k).Text, Range("F" & i).Text)
If j > 0 Then
l = InStrRev(Range("F" & k).Text, " \ ")
If l > 0 Then
convert_i = Range("F" & i).Value
convert_k = Range("F" & k).Value
last_part = Right(convert_k, Len(convert_k) - l - 2)
Range("F" & k).Value = Range("F" & i).Text & " \ " & last_part
Else:
Range("F" & k).Value = Range("F" & i).Value & " \ " & Range("F" & k).Value
End If
End If
Next k
Next i
MsgBox ("Finished ")
End Sub
I realised my implementation was terrible, I was confused by getting it almost 70 percent right. The above code got the job done. Might as well delete the question as I don't think it would be of help to anybody.