[Solved] Using specific column values to create a table

Question

I think there are still some questions to be answered (see my comments) but the following is a starting point with some assumptions made.

1) I leave the number of columns for the output table in a constant variable so you can choose how many columns you want:

Const numberOfColumnsInTable = 4

2) I make a list of items to ignore and store them in an array so you can easily extend/amend your selection:

wordsToExclude = Array("NO", "*", "Start", "END")

3) I store all the column data in a 2D array read from the sheet. This is much faster than working with the sheet in a loop.

4) I loop the first dimension of the input array (arrayIn), checking if the current value is found in the array. If not found an error will be raised which I check for.

IsError(Application.Match(arrIn(i, 1), wordsToExclude, 0))

If error then I keep the value and store in an output array (arrayOut).

5) I re-dimension the output array, to only the populated rows, and write to the sheet.

Code:

Option Explicit
Public Sub OrderInTable()
    Dim ws As Worksheet, arrIn(), arrOut(), i As Long, wordsToExclude(), rowCounter As Long, columnCounter As Long
    Dim counter As Long
    Const numberOfColumnsInTable = 4

    wordsToExclude = Array("NO", "*", "Start", "END")
    Set ws = ThisWorkbook.Worksheets("Sheet13")

    With ws
        arrIn = .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value
        ReDim arrOut(1 To UBound(arrIn, 1), 1 To numberOfColumnsInTable)
        For i = LBound(arrIn, 1) To UBound(arrIn, 1)
            If IsError(Application.Match(arrIn(i, 1), wordsToExclude, 0)) Then
                counter = counter + 1
                If counter Mod numberOfColumnsInTable = 1 Then
                    rowCounter = rowCounter + 1: columnCounter = 1
                Else
                   columnCounter = columnCounter + 1
                End If
                arrOut(rowCounter, columnCounter) = arrIn(i, 1)
            End If
        Next
        arrOut = Application.WorksheetFunction.Transpose(arrOut)
        ReDim Preserve arrOut(1 To numberOfColumnsInTable, 1 To rowCounter)
        arrOut = Application.WorksheetFunction.Transpose(arrOut)

        .Range("C1").Resize(UBound(arrOut, 1), UBound(arrOut, 2)) = arrOut
    End With
End Sub

Accepted Answer