Expanding Info From One Sheet To Another VBA

[Ryan245]

I'm wondering if someone can please help me out in creating a template VBA I can use to "expand" a list I create for doors on different new designs we do. I tried doing a pivot table but it doesn't go as in-depth so I believe creating VBA that I can use to create the new list is best. I have attached a "before" and "after" sample I'd like to create. So to explain simply we have many different hardware boards that have different devices and it varies from door to door. Each board will be consistent so we will always have the number column 1-32 i.e 8 doors per board and 4 device slots per door(not all slots are always taken up). The doors are assigned to boards and they are terminated from least to greatest i.e door D-1-01 is on terminal 1 and D-1-02 is on terminal 2 ALWAYS. So I'm looking to create a code that will look at the name of the board, determine the name of the door and which devices are on it. There can only be 4 devices per door but some doors don't have all the same devices. Some might have all 4, some maybe just 2, etc. Can someone please assist in creating VBA that I can use as a button click on the "before" sheet that will generate a separate sheet i.e. "after?"

As Always, any support is greatly appreciated!

Here's the current code I have but it doesn't' work for every case i.e. unexpected items in column M I may run into in the future:

[COLOR=#333333]Sub test()[/COLOR]
<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">    Dim a, i As Long, ii As Long, myIndex As Long
    Dim b, n As Long, myList, x, y, temp
    With Cells(1).CurrentRegion.Resize(, 13)
        a = Application.Index(.Value, Evaluate("row(1:" & _
        Range("j" & Rows.Count).End(xlUp).Row & ")"), [{10,5,5,13}])
    End With
    ReDim b(1 To UBound(a, 1) * 4, 1 To 4)
    For i = 2 To UBound(a, 1)
        a(i, 3) = a(i, 1) & " " & a(i, 2)
    Next
    VSortM a, 2, UBound(a, 1), 3
    myList = Array("cr", "rex", "dc")
    For i = 2 To UBound(a, 1)
        If a(i, 4) <> "" Then x = Split(a(i, 4), ", ")
        For ii = 1 To 4
            If temp <> a(i, 1) Then myIndex = 0: temp = a(i, 1)
            myIndex = myIndex + 1: n = n + 1
            b(n, 1) = a(i, 1): b(n, 2) = a(i, 2): b(n, 3) = myIndex
            If IsArray(x) Then
                If ii < 4 Then
                    y = Application.Match(myList(ii - 1) & "*", x, 0)
                    If IsNumeric(y) Then
                        b(n, 4) = myList(ii - 1) & "_" & b(n, 2)
                        x(y - 1) = ""
                    End If
                Else
                    If Len(Join(x, "")) Then b(n, 4) = "ps_" & b(n, 2)
                End If
            End If
        Next
    Next
    With Sheets.Add.Cells(1).Resize(, 4)
        .Resize(, 5).Value = Array("board", "door", "number", "tag", "other")
        .Rows(2).Resize(n).Value = b
    End With
End Sub

Sub VSortM(ary, LB, UB, ref)
    Dim i As Long, ii As Long, iii As Long, M, temp
    i = UB: ii = LB
    M = ary(Int((LB + UB) / 2), ref)
    Do While ii <= i
        Do While ary(ii, ref) < M: ii = ii + 1: Loop
        Do While ary(i, ref) > M: i = i - 1: Loop
        If ii <= i Then
            For iii = LBound(ary, 2) To UBound(ary, 2)
                temp = ary(ii, iii): ary(ii, iii) = ary(i, iii): ary(i, iii) = temp
            Next
            i = i - 1: ii = ii + 1
        End If
    Loop
    If LB < i Then VSortM ary, LB, i, ref
    If ii < UB Then VSortM ary, ii, UB, ref </code>[COLOR=#333333]End Sub[/COLOR]