macro

Private Sub CommandButton1_Click()
    'Define Workbook And Sheet For Parsing
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim twb As Workbook
    Dim tws As Worksheet

    Set wb = Workbooks.Open("G:\Spero\Utilities\BB Class List Base.xlsx")
    Set ws = wb.Worksheets("program_status_report")
    Set twb = ThisWorkbook
    Set tws = ThisWorkbook.Worksheets("Sheet1")

    'Classify Different Status Types
    Dim i As Long
    Dim statusTypes(16) As String
    Dim statusTypeCount(16) As Integer
    Dim numStatusTypes As Integer
    Dim element As Variant
    Dim element2 As Variant
    Dim match As Boolean

    numStatusTypes = 0

    For i = 4 To ws.Rows.count
        If Not IsEmpty(ws.Cells(i, 4)) Then
            match = False
            Dim mStr As String
            Dim count As Integer
            mStr = ws.Cells(i, 4)
            count = 0

            For Each element In statusTypes
                count = count + 1
                If (mStr = element) Then
                    match = True
                    statusTypeCount(count) = statusTypeCount(count) + 1
                    tws.Cells(count - 1, 5) = statusTypeCount(count) + 1
                End If
            Next element

            If (match = False) Then
                numStatusTypes = numStatusTypes + 1
                statusTypes(numStatusTypes) = ws.Cells(i, 4)
                tws.Cells(numStatusTypes, 4) = ws.Cells(i, 4)
            End If
        End If
    Next i

    'Priority For Organization
    Dim priority(16) As String
    priority(1) = "Phase 1"
    priority(2) = "Phase 2"
    priority(3) = "Phase 3"
    priority(4) = "Phase 4"
    priority(5) = "Class 1"
    priority(6) = "Class 2"
    priority(7) = "Class 3"
    priority(8) = "Class 4"
    priority(9) = "Class 5"
    priority(10) = "Class 6"
    priority(11) = "Transition"
    priority(12) = "Advanced 1"
    priority(13) = "Advanced 2"

    Dim extraStatus(16) As String
    Dim numExtraStatus As Integer
    Dim curRows As Integer

    curRows = 1
    numExtraStatus = 0

    For Each element2 In priority
        Dim its As Integer
        its = 0
        For Each element In statusTypes
            its = its + 1
            If (UCase(element2) = UCase(element)) And (its <= 16) Then
                Dim x As Integer
                tws.Cells(curRows, 1) = element
                x = curRows + (statusTypeCount(its) \ 4)
                curRows = x + 2
            End If
        Next element
    Next element2

    'Row Iteration Variables
    Dim rw As Range
    Dim RowCount As Integer

    RowCount = 4

    For Each rw In ws.Rows
        Dim nameStr As String
        If Not IsEmpty(ws.Cells(RowCount, 2)) Then
            'tws.Cells(RowCount - 3, 1) = ws.Cells(RowCount, 2) & " " & ws.Cells(RowCount, 3)
        End If
        If Not IsEmpty(ws.Cells(RowCount, 1)) Then
            'tws.Cells(RowCount - 3, 2) = ws.Cells(RowCount, 1)
        Else
            Exit For
        End If
        RowCount = RowCount + 1
    Next rw

    'Close Unparsed Workbook
    Call wb.Close(False)

End Sub