Excel VBA: insert empty columns among non empty columns

Hello experts,

I am looking for a procedure in order to insert multiple non empty column among non empty columns the requirement is the following:

1-Loop the various active columns
2-Inputbox insert the number of columns that you want to insert between empty columns.
3-Insert empty columns
4-Take as a reference the header of left column for inserted column


Example: Empty columns have been inserted for column A C E, left header has been parse for inserted column.

Insert-empty-columns.png
II attached dummy file.

Thank you in advance for your help.
Insert-empty-columns.xlsx
LVL 1
LD16Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

NorieAnalyst Assistant Commented:
Not 100% sure what you are after, a before/after would have been useful, but try this.
Sub InsertEmptyColumns()
Dim NoCols As Long
Dim Col As Long

    NoCols = InputBox("How many empty columns do you want to insert?")
    
    Col = Cells(1, Columns.Count).End(xlToLeft).Column
    
    Do
        Columns(Col).Offset(, 1).Resize(, NoCols).EntireColumn.Insert
        Cells(1, Col).Resize(, NoCols + 1).Value = Cells(1, Col)
        Col = Col - 1
    Loop Until Col < 1
        
End Sub

Open in new window

LD16Author Commented:
Please find attached dummy file with Input and Output sheet;

The proposed procedure doesn't fill header name with "New" & left column header as reported in output sheet in highlighted in gree.

Thank you very much for your help.
Insert-columns-V2.xlsx
NorieAnalyst Assistant Commented:
There was no mention of 'New' in the original question.:)

I'll take a look at the attachment though.
Price Your IT Services for Profit

Managed service contracts are great - when they're making you money. Yes, you’re getting paid monthly, but is it actually profitable? Learn to calculate your hourly overhead burden so you can master your IT services pricing strategy.

NorieAnalyst Assistant Commented:
This will name the new columns with the existing column name prefixed with 'New_'.
Sub InsertEmptyColumns()
Dim NoCols As Long
Dim Col As Long

    NoCols = InputBox("How many empty columns do you want to insert?")
    
    Col = Cells(1, Columns.Count).End(xlToLeft).Column
    
    Do
        Columns(Col).Offset(, 1).Resize(, NoCols).EntireColumn.Insert
        Cells(1, Col).Offset(, 1).Resize(, NoCols).Value = "New_" & Cells(1, Col).Value
        Col = Col - 1
    Loop Until Col < 1
        
End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Theo KouwenhovenApplication ConsultantCommented:
Is the standard Exel option not enough?

Select column A,B and C and choose (right-button) insert, 3 columns inserted (A is moved to D)
LD16Author Commented:
@Norie: Thank you for this proposal. Possible to add green field at new headers inserted?
Thank you in advance for your help.
LD16Author Commented:
I was able to performed last requirement by adding line 12 of Nories's proposal. Thank you all.

Sub Insert_Empty_Cols()
Dim NoCols As Long
Dim Col As Long

    NoCols = InputBox("How many empty columns do you want to insert?")
    
    Col = Cells(1, Columns.Count).End(xlToLeft).Column
    
    Do
        Columns(Col).offset(, 1).Resize(, NoCols).EntireColumn.Insert
        Cells(1, Col).offset(, 1).Resize(, NoCols).Value = "New_" & Cells(1, Col).Value
        Cells(1, Col).offset(, 1).Resize(, NoCols).Interior.Color = RGB(98, 244, 66)
        
        Col = Col - 1
    Loop Until Col < 1
        
End Sub

Open in new window

It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.