Creating new table from existing excel sheet in vb

Question

I have an excel sheet with many columns and an unknown number of rows. I'm trying to write a VB macro to dynamically convert the data from a few selected columns and all rows into a table.

I'm running into some syntaxt issues. Everything I find says to use the As syntax. For example:

Dim workRow As DataRow = table.NewRow()

or

Dim table As New DataTable

But whenever I do this I get an error Expected: End of statement

Here is my code:

Sub CreateTable()
    FinalRow = Cells(Rows.Count, 6).End(xlUp).Row
    
    Dim table
    table = DataTable("TotOpenOI")
    Dim strike
    strike = DataColumn("Strike", GetType(Int32))
    Dim expiry
    expiry = DataColumn("Expiry", GetType(DateTime))
    Dim callDelta
    callDelta = DataColumn("Call Delta", GetType(Int32))
    Dim putDelta
    putDelta = DataColumn("Put Delta", GetType(Int32))
    
    Dim tableRow
    
    For i = 6 To FinalRow
        tableRow = DataRow.NewRow()
        tableRow(0) = strike
        tableRow(1) = expiry
        tableRow(2) = callDelta
        tableRow(3) = putDelta
        table.Rows.Add (tableRow)
    Next
End Sub

I want to create a new table with the columns: strike, expiry, callDelta, PutDelta and use every row from 1 to last -- starts at row 6.

Note: I'm only using those 4 columns but there are 20 or so columns in my spreadsheet.

Thank you.

My goal is to create a pivot table out of the columns I highlighted in my original question. The data I'm pulling in has a lot of columns I don't need and the API doesn't allow me to remove columns in the query. So I want to create a new, more condensed table out of the data to then use to create a pivot table. I added a screen shot of the chart I'm creating from the selected data.

Answer 1

Export Columns to a New Excel Table

• The following will delete the destination worksheet and add a new one!

Sub ExportColumnsToNewTable()

    ' Define constants.
    Const PROC_TITLE As String = "Export Columns to a New Excel Table"
    Const SRC_SHEET_NAME As String = "Sheet1"
    Const SRC_HEADER_ROW As Long = 6
    Const DST_SHEET_NAME As String = "Sheet2"
    Const DST_TABLE_NAME As String = "StrikeExpiry"
    Const DST_FIRST_CELL As String = "A1"
    Dim Headers() As Variant:
    Headers = VBA.Array("Strike", "Expiry", "CallDelta", "PutDelta")
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Reference the source range ('srg').
    Dim sws As Worksheet: Set sws = wb.Sheets(SRC_SHEET_NAME)
    Dim cCount As Long: cCount = UBound(Headers) + 1 ' zero-based
    Dim srg As Range
    With sws.UsedRange
        Dim sfcell As Range: Set sfcell = sws.Cells(SRC_HEADER_ROW, .Column)
        Dim slcell As Range: Set slcell = .Cells(.Cells.CountLarge)
        If slcell.Row - sfcell.Row < 1 Then ' headers (+1)
            MsgBox "Not enough rows of data found!", _
                vbInformation, PROC_TITLE
            Exit Sub
        End If
        If slcell.Column - sfcell.Column + 1 < cCount Then
            MsgBox "Not enough columns of data found!", _
                vbInformation, PROC_TITLE
            Exit Sub
        End If
        Set srg = sws.Range(sfcell, slcell)
    End With
       
    ' Retrieve the source column indexes ('scIndexes').
    Dim scIndexes() As Variant:
    scIndexes = Application.Match(Headers, srg.Rows(1), 0)
    Dim c As Long
    If Application.Count(scIndexes) < cCount Then
        Dim iMsg As String
        For c = 1 To cCount
            If IsError(scIndexes(c)) Then
                iMsg = iMsg & vbLf & Headers(c - 1)
            End If
        Next c
        iMsg = "The following headers could not be found: " & vbLf & iMsg
        MsgBox iMsg, vbCritical, PROC_TITLE
        Exit Sub
    End If
    
    ' Write the values from the source range to the source array ('sData').
    Dim sData() As Variant: sData = srg.Value
    
    ' Define the destination array ('dData').
    Dim rCount As Long: rCount = UBound(sData, 1)
    Dim dData() As Variant: ReDim dData(1 To rCount, 1 To cCount)

    ' Write the values from the designated columns of the source array
    ' to the destination array.
    Dim r As Long, sc As Long
    For c = 1 To cCount
        sc = scIndexes(c)
        For r = 1 To rCount
            dData(r, c) = sData(r, sc)
        Next r
    Next c

    Application.ScreenUpdating = False

    ' Delete the destination sheet.
    Dim dsh As Object:
    On Error Resume Next
        Set dsh = wb.Sheets(DST_SHEET_NAME)
    On Error GoTo 0
    If Not dsh Is Nothing Then
        Application.DisplayAlerts = False ' delete without confirmation
            dsh.Delete
        Application.DisplayAlerts = True
    End If
    
    ' Add a new (destination) worksheet.
    Dim dws As Worksheet:
    Set dws = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
    dws.Name = DST_SHEET_NAME
    
    ' Write the values from the destination array to the destination range.
    Dim dfcell As Range: Set dfcell = dws.Range(DST_FIRST_CELL)
    Dim drg As Range: Set drg = dfcell.Resize(rCount, cCount)
    drg.Value = dData
    
    ' Convert the destination range to a table.
    Dim dlo As ListObject:
    Set dlo = dws.ListObjects.Add(xlSrcRange, drg, , xlYes)
    On Error Resume Next
        dlo.Name = DST_TABLE_NAME
    On Error GoTo 0
    drg.EntireColumn.AutoFit
    ' or dlo.Range.EntireColumn.AutoFit
    
    ' Additional Ideas:
    'sws.Activate
    'wb.Save
    
    Application.ScreenUpdating = True
    
    ' Inform.
    MsgBox "Columns exported to table """ & dlo.Name _
        & """ in worksheet """ & DST_SHEET_NAME & """.", _
        vbInformation, PROC_TITLE

End Sub