Effficient Way to Insert columns, renaming Column Headers and using Len to count the cells

[bearcub]

I have this macro that I just recorded using the macro recorder and it is way too long and messy. I would like a more efficient way of how to do this (so I could write something like this on my own).

I have 6 columns in a report where i want to insert a blank column, rename each one of them and then add the Len function to the column to the left of it to count the number of characters.

The range of columns that will be inserted is from Column K:R. After all the columns have been inserted the new range extends from K:Z (including the 8 additional columns)

The first column that will be inserted will be in column K (note that the Len function points to K2).


Here is a snippet of the code I got from the macro recorder:

Sub InsertColumn_PhoneCount()
'
' InsertColumn_PhoneCount Macro
'
On Error Resume Next
    Columns("L:L").Select
    Selection.Insert Shift:=xlToRight
    Range("Table1[[#Headers],[Column1]]").Select
    ActiveCell.FormulaR1C1 = "Primary Count"
    Columns("N:N").Select
    Selection.Insert Shift:=xlToRight
    Range("Table1[[#Headers],[Phone Count]]").Select
    ActiveCell.FormulaR1C1 = "Home Count"
    Selection.Copy
    Range("Table1[[#Headers],[Column1]]").Select
    ActiveSheet.Paste
    Columns("N:N").Select
    Application.CutCopyMode = False
    Selection.Copy
    Columns("P:P").Select
    Application.CutCopyMode = False

    ActiveCell.FormulaR1C1 = "=LEN(K2)"
    Range("L2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("N2").Select
    ActiveSheet.Paste
    Range("P2").Select
    ActiveSheet.Paste
    Range("R2").Select
    ActiveSheet.Paste
    Range("T2").Select
    ActiveSheet.Paste
    Range("V2").Select
    ActiveSheet.Paste
    Range("X2").Select
    ActiveSheet.Paste
    Range("Z2").Select
    ActiveSheet.Paste

I was thinking that i could use a For Next statement to add the columns but I'm not sure how to go about doing this.

I have the sheet as an Excel Table so the formulas will fill down automatically (there are presently over 67,000 rows on the spreadsheet).

Thank you for your help in Advance,

Michael

 

[pbornemeier]

K:R is 8 columns (not 6) and inserting a column after each of them will take it to K:Z
I am guessing you are adding The previous column header + " Count" to the header of each inserted column.

This code will modify the first table on the active sheet. TEST ON A COPY OF YOUR DATA

Option Explicit

Sub ExpandTable()
    'https://www.mrexcel.com/forum/excel-questions/1044730-effficient-way-insert-columns-renaming-column-headers-using-len-count-cells.html
    
    'Insert columns after each column in the first listobject on the activesheet
    'Add header to each inserted column that consists of its left cell value + " Count"
    'Add LEN for cell left of each inserted column in 2nd and subsequent rows
    
    Dim tbl As ListObject
    Dim lColIndex As Long
    
    Set tbl = ActiveSheet.ListObjects(1)
    
    'Add columns and headers after all but last column
    For lColIndex = tbl.Range.Columns.Count To 2 Step -1
        tbl.Range.Columns(lColIndex).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        tbl.Range.Cells(1, lColIndex).Value = tbl.Range.Cells(1, lColIndex - 1).Value & " Count"
    Next

    'Add column and header after last column
    tbl.Resize Union(tbl.Range, tbl.Range.Offset(0, 1))
    lColIndex = tbl.Range.Columns.Count
    tbl.Range.Cells(1, lColIndex).Value = tbl.Range.Cells(1, lColIndex - 1).Value & " Count"
    
    'Add Count Formula to inserted columns
    With tbl.Range.Cells(2, 2)
        .FormulaR1C1 = "=LEN(RC[-1])"
        .Copy
    End With
    For lColIndex = 4 To tbl.Range.Columns.Count Step 2
        tbl.Range.Cells(2, lColIndex).Select
        ActiveSheet.Paste
    Next
    
End Sub

 

[bearcub]

Thank you Phil, you're correct. I"m inserting columns to expand the range. My goal is to count the number of characters in the cell to the left of the inserted column. I'll test your code this morning when I get to work and let you know how it works.

Thank you again for your help,

Michael

 

[bearcub]

Hi Phil,

I ran the code and it does insert a column in every column. How do I modify the code so that it inserts a column starting in Column L? I only want to insert columns.

The initial range is from Column L to Column R. inserting 8 columns with expand the initial ranage from Column L to Column Z. In between each of the original columns is a column with the Len function pointing to the cell do the left of it.

this is where I think the procedure needs to be amended but I not sure how to restrict it to adding only 8 columns:

For lColIndex = tbl.Range.Columns.Count To 2 Step -1

So the columns impacted initially would be from 10 to 18. After the code is run this range will expand to 10 to 26 (with the addition of the 8 columns). I don't need to add a column for every column, only a small section of my spreadsheet. I have 77 columns of data by 67000 rows!

How to do I modify the For loop to stop on column 18 though it would row 26 after the procedure has run?

Thank you for the help,

Michael

 

[pbornemeier]

Modified the code so start and end columns could be specified. Note that the range of columns to have columns inserted after then are specified using first and last column position in the table, not their position on the worksheet.

Option Explicit

Sub ExpandTable()
    'https://www.mrexcel.com/forum/excel-questions/1044730-effficient-way-insert-columns-renaming-column-headers-using-len-count-cells.html
    
    'Insert columns after specified columns in the first listobject (table) on the active worksheet
    'Update values for lFirstColumn & lLastColumn below
    'Add header to each inserted column that consists of its left cell value + " Count"
    'Add LEN for cell left of each inserted column in 2nd and subsequent rows
    
    Dim tbl As ListObject
    Dim lColIndex As Long
    Dim lFirstColumn As Long
    Dim lLastColumn As Long
    Dim lTableColumnCount As Long
    
    lFirstColumn = 1  'The first column in the table that will have a column inserted after it
    lLastColumn = 8   'The last column in the table that will have a column inserted after it
                                    '  if this is greater than the total number of columns in the table
                                    '  the last table column will be used.
    
    Set tbl = ActiveSheet.ListObjects(1)
    
    lTableColumnCount = tbl.Range.Columns.Count
    If lLastColumn > lTableColumnCount Then lLastColumn = lTableColumnCount
    
    'Add columns and headers after all but last column
    For lColIndex = lLastColumn + IIf(lTableColumnCount > lLastColumn, 1, 0) To lFirstColumn + 1 Step -1
        tbl.Range.Columns(lColIndex).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        tbl.Range.Cells(1, lColIndex).Value = tbl.Range.Cells(1, lColIndex - 1).Value & " Count"
    Next

    If lLastColumn = lTableColumnCount Then
        'Add column and header after rightmost table column
        tbl.Resize Union(tbl.Range, tbl.Range.Offset(0, 1))
        lColIndex = tbl.Range.Columns.Count
        tbl.Range.Cells(1, lColIndex).Value = tbl.Range.Cells(1, lColIndex - 1).Value & " Count"
    End If
    
    'Add LEN Formula to inserted columns
    With tbl.Range.Cells(2, lFirstColumn + 1)
        .FormulaR1C1 = "=LEN(RC[-1])"
        .Copy
    End With
    For lColIndex = 4 To 2 * (lLastColumn - lFirstColumn + 1) Step 2
        tbl.Range.Cells(2, lColIndex).Select
        ActiveSheet.Paste
    Next
    
End Sub

 

[bearcub]

Thank you Phil, not quite there. It inserts a new column after ColumnA. I do get 8 new columns but they are based on the 1st 8 columns (A:H) not K:R.

I tried changing the variables below to 1 to 8 to 11 to 18 but the len formula occurs only on row 2 without any new columns

  lFirstColumn = 1  'The first column in the table that will have a column inserted after it
    lLastColumn = 8

  lFirstColumn = 11  'The first column in the table that will have a column inserted after it
    lLastColumn =18

For the most part it does what I want it to do but I need it to start in column 11 (K) to 18 (R). Tweaking the starting point with the variables as I did above results in the row 2 having Len formula only.

Where would the starting and ending columns be modified in the code.

Sorry to be a pain. It works if I were starting at Col A.


This is how I would modify the comments

    'Insert columns after specified columns in the first listobject (table) on the active worksheet starting in column K and ending in column R (adding 8 columns only)
    'Update values for lFirstColumn & lLastColumn below
    'Add header to each inserted column that consists of its left cell value + " Count"
    'Add LEN for cell left of each inserted column in 2nd and subsequent rows

Thank you for the help,

Michael

 

[pbornemeier]

In your first post the recorded data shows that your data is in a table. Do you still have you data in a table (as in Insert | Table) or is your data in a normal range in the worksheet? When I test the code with a data in a table it works fine. When I try without the table I get an error at the line:

Set tbl = ActiveSheet.ListObjects(1)

which is expected since there is no table.

 

[bearcub]

I do have it set up as a table (ctr T).

I ran the macro several times and it always seemed to insert columns starting with Column B (starting in Column A) not Column L (starting in column K).

Does it make a difference where you have the cursor? How does your code know where the first column to insert is in Column L not Column B.

Michael

 

[pbornemeier]

The position of the cursor will make no difference
This line

    Set tbl = ActiveSheet.ListObjects(1)

defines the tbl object as the first ListObject (table) that was created on the Active worksheet.
Do you also have a table that starts in column A that was the first one on the worksheet?
Using the values I assigned in post #5 :

    lFirstColumn = 1  'The first column in the table that will have a column inserted after it
    lLastColumn = 8   'The last column in the table that will have a column inserted after it
                                    '  if this is greater than the total number of columns in the table
                                    '  the last table column will be used.

This line (neglecting the IIf statement which handles the case where a column needs to be inserted after the last column in a table)

    lColIndex = lLastColumn + IIf(lTableColumnCount > lLastColumn, 1, 0) To lFirstColumn + 1 Step -1

will vary the value of lColIndex from 8 to 1
So that this line will start inserting columns to the left of Column 8,7,6,5...1 of the table.

    tbl.Range.Columns(lColIndex).Insert

 

[bearcub]

Thank you for the explanation.

When I run this macro it inserts columns going to the left of Column K instead of to the right.

Based upon your last statement, it sounds like the macro is inserting columns to the left of column K not to the right of Column K. If the code was increased by 8 columns would all the inserted columns go from Column K:Column Z as opposed to Column A:Column K

The table starts in column A and extends to column BH. I wonder why the macro isn't working the way you describe it. If I were to change the 1 to 11 and 8 to 18 would this insert columns to the right of K?

Again, that you for your patience. Your code is marvelous and I will definitely use it. But, for some reason, it isn't inserting columns to the right of Column K.

Thank you for all your help and time you've put into this, sorry for being a pain!

Michael