简体   繁体   中英

How do I correctly add Table Columns in Excel using VBA?

Problem : I'm receiving intermittent results when using VBA to add columns to tables in multiple workbooks. In once case, I receive an out of range error. Sometimes all the new columns are added but most times it adds only a few, and carries the remaining column titles to the next row instead of creating a column.

What I am trying to do : I'm trying to add 7 columns to the existing table and then add data to those columns referencing the existing table data in each row.

What I have tried : I've tried different versions of code.

I added this code at the beginning, prior to looping to add data. This code errors with a "script out of range" error. It will add the first two columns, it will add the third column name to the first cell in the first row, and then error when trying to add the 4th. The tblCols variable is the count of all the table columns prior to adding the new columns.

Worksheets(wsName).ListObjects(tblName).ListColumns.Add(tblCols + 1).Name = "Transaction Name In"
Worksheets(wsName).ListObjects(tblName).ListColumns.Add(tblCols + 2).Name = "Transaction Name Out"
Worksheets(wsName).ListObjects(tblName).HeaderRowRange(tblCols + 3) = "Batch Map Name"    
Worksheets(wsName).ListObjects(tblName).ListColumns.Add(tblCols + 4).Name = "Inbound Path and File"
Worksheets(wsName).ListObjects(tblName).ListColumns.Add(tblCols + 5).Name = "Outbound Path and File"
Worksheets(wsName).ListObjects(tblName).ListColumns.Add(tblCols + 6).Name = "Lookup Tables"
Worksheets(wsName).ListObjects(tblName).ListColumns.Add(tblCols + 7).Name = "Logical Path"

If I use the code below and simply add the new data, most times, simply adding this data forces the creation of the new columns and then the code following the loop is used to name the headers. However, this doesn't always work either. I won't get an error, but the last few column headers will be written to the first row instead of a column being created. I don't have any problems with the looped code.

    Dim x As Long

For x = 1 To tblRows
    Worksheets(wsName).ListObjects(tblName).DataBodyRange(x, (tblCols + 1)) = CreateTransInName(x)
    Worksheets(wsName).ListObjects(tblName).DataBodyRange(x, (tblCols + 2)) = CreateTransOutName(x)
    Worksheets(wsName).ListObjects(tblName).DataBodyRange(x, (tblCols + 3)) = CreateBatchMapName(x)
    
    Worksheets(wsName).ListObjects(tblName).DataBodyRange(x, (tblCols + 4)) = CreateInboundPath(x)
    Worksheets(wsName).ListObjects(tblName).DataBodyRange(x, (tblCols + 5)) = CreateOutboundPath(x)
    Worksheets(wsName).ListObjects(tblName).DataBodyRange(x, (tblCols + 6)) = CopyLookupTables(x)
    Worksheets(wsName).ListObjects(tblName).DataBodyRange(x, (tblCols + 7)) = CreatelogicalPath(x)
Next

DoEvents

Worksheets(wsName).ListObjects(tblName).HeaderRowRange(tblCols + 1) = "Transaction Name In"
Worksheets(wsName).ListObjects(tblName).HeaderRowRange(tblCols + 2) = "Transaction Name Out"
Worksheets(wsName).ListObjects(tblName).HeaderRowRange(tblCols + 3) = "Batch Map Name"

Worksheets(wsName).ListObjects(tblName).HeaderRowRange(tblCols + 4) = "Inbound Path and File"
Worksheets(wsName).ListObjects(tblName).HeaderRowRange(tblCols + 5) = "Outbound Path and File"
Worksheets(wsName).ListObjects(tblName).HeaderRowRange(tblCols + 6) = "Lookup Tables"
Worksheets(wsName).ListObjects(tblName).HeaderRowRange(tblCols + 7) = "Logical Path"
MsgBox "Naming Convention Completed"

If anyone has a suggestion, I'm open to it. I'm really a little baffled with the first block of code won't work.

You can use something along these lines to add columns. Put all of your column names in a string array, then iterate over the items, adding as you go.

Public Sub AddColumnsToTable()

Dim ColumnHeaders(1 To 3) As String
Dim col As ListColumn
Dim i As Integer

ColumnHeaders(1) = "Hello"
ColumnHeaders(2) = "This is"
ColumnHeaders(3) = "A new column"

For i = 1 To 3

    Set col = Me.ListObjects(1).ListColumns.Add
    col.Name = ColumnHeaders(i)

Next i

End Sub

Correcting my copy/paste mistake, replacing HeaderRowRange with ListColumns.Add on line 3 of the first block of code was the fix. This first block of code in my post is the correct way to add columns. I simply made a mistake and thankfully someone caught it.

Changing this:

Worksheets(wsName).ListObjects(tblName).HeaderRowRange(tblCols + 3) = "Batch Map Name"

To this:

Worksheets(wsName).ListObjects(tblName).ListColumns.Add(tblCols + 3) = "Batch Map Name"

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM