Grouping by Categories and SubCategories

Hi, perhaps my attempt will be successful.

Sub Output1_2()
    Dim a(), id, k, kk, v, All_IDs
    Dim d As Object, r As Object
    Dim i As Integer, ii As Integer, rws As Integer
    Dim ms As String, tmp As String
        
    With Sheets("Raw Data")
        lr = .Cells(Rows.Count, "A").End(xlUp).Row
        a = .Range("A2:A" & lr).Value
    End With
    rws = UBound(a)
    Set r = CreateObject("VBScript.RegExp")
    r.IgnoreCase = True
    r.Global = True
    r.Pattern = "[^0-9]+"
    Set d = CreateObject("Scripting.Dictionary")
    With d
        For i = 1 To rws
            ms = Application.Substitute(a(i, 1), "Location:", "")
            If ms Like "Folder*" Then
                tmp = ms
                If Not .exists(ms) Then _
                    Set .Item(ms) = CreateObject("Scripting.Dictionary")
            Else
                If tmp Like "Folder*" And a(i, 1) Like "SubFolder*" Then
                    If r.test(a(i + 1, 1)) Then
                            v = r.Execute(a(i + 1, 1))(0)
                        .Item(tmp).Item(ms) = Application.Substitute(a(i + 1, 1), v, "")
                    End If
                    i = i + 1
                End If
            End If
        Next i
    End With
    With Sheets("testOut1")
        .UsedRange.ClearContents
        i = 1
        For Each k In d.keys
            .Cells(.Cells(Rows.Count, i).End(3).Row, i) = k
            ii = ii + 2
            For Each kk In d.Item(k).keys
                .Cells(.Cells(Rows.Count, i).End(3).Row + ii, i) = kk
                ii = ii - 1
                id = d.Item(k).Item(kk)
                All_IDs = IIf(Len(All_IDs) = 0, id, All_IDs & "," & id)
                id = Split(id, ", ")
                .Cells(.Cells(Rows.Count, i).End(3).Row + ii, i).Resize(UBound(id) + 1, 1) = _
                                                                                Application.Transpose(id)
                ii = 2
            Next
            i = i + 1: ii = 0
        Next
    End With
    v = Split(All_IDs, ",")
    d.RemoveAll
    With Sheets("testOut2")
        .UsedRange.Offset(1, 0).ClearContents
        For i = 0 To UBound(v)
            ms = Trim(Split(v(i), "-")(0))
            d(ms) = Empty
        Next
        .[A2].Resize(UBound(v)) = Application.Transpose(v)
        .[B2].Resize(d.Count) = Application.Transpose(d.keys)
        v = Join(d.keys, " | ")
        .[C2] = Application.Transpose(v)
    End With
    Set d = Nothing
    Set r = Nothing
End Sub