VBA for inserting and deletion of new columns

thought you can easily do that by recording a Macro?

quick examples:

1) Insert 3 columns from column F to column H

Columns("F:H").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Select allOpen in new window

2) Delete column from column L to column N

Columns("L:N").Select
Range("N1").Activate
Selection.Delete Shift:=xlToLeft

Select allOpen in new window

The solution will depend upon the following questions...

1) New columns should be inserted at a click of a button between two specified columns.

What are those specified columns? Are they fixed or may vary?

2) Once we are done with our work on the newly inserted columns, there should be a button to delete the columns

Which columns to delete?

Why not just insert the columns manually and keep them hidden until needed?

@Subodh Tiwari : Please find my answers inline to your query below:

1) New columns should be inserted at a click of a button between two specified columns.
What are those specified columns? Are they fixed or may vary?

Ans: These are fixed columns - for e.g. Name and Designation

2) Once we are done with our work on the newly inserted columns, there should be a button to delete the columns
Which columns to delete?

Ans : We need to delete the columns which we have created above once our work is over with them

Hope this helps.

@ Roy Cox : This is a dynamic excel sheet which would be utilised by many users and the option to hide and unhide isn't an option.

Does that mean you have headers Name and Designation in Row1 and you want to insert columns between these two columns? If yes, how many columns you want to insert after clicking the button?

Also, when you want to delete the columns, do you want to delete all columns between the columns Name and Designation columns?

Hi Kailash,

Try below:

Sub InsertColumn()
Dim Ws As Worksheet
Dim HeaderRng As Range, SpecificHeader As Range
Set Ws = ThisWorkbook.Worksheets("Sheet1")
Set HeaderRng = Ws.Range("1:1")
Set SpecificHeader = HeaderRng.Find(What:="Name", After:=Ws.Cells(1, 1))
Application.ScreenUpdating = False
SpecificHeader.Offset(0, 1).EntireColumn.Insert
SpecificHeader.Offset(0, 1).Value = "Working"
Application.ScreenUpdating = True
End Sub

Sub DeleteColumn()
Dim Ws As Worksheet
Dim HeaderRng As Range, SpecificHeader As Range
Set Ws = ThisWorkbook.Worksheets("Sheet1")
Set HeaderRng = Ws.Range("1:1")
Set SpecificHeader = HeaderRng.Find(What:="Working", After:=Ws.Cells(1, 1))
Application.ScreenUpdating = False
On Error Resume Next
SpecificHeader.EntireColumn.Delete
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Select allOpen in new window

Check in attached...
KailashKapal_InsertDeleteColumn.xlsm

As Subodh mentioned, we are not sure if you want to insert just 1 column between Name & Destination Column? If your answer is YES, then above code will fulfill your requirement.

@ Shums : Thanks for helping out. Is it possible to insert multiple columns ? If yes, please provide the updated code.

How many Columns do you need?
Will those columns be between Name & Destination?

@Shums : Can it be a variable number ? Yes they should be between Name and Destination. THe main purpose of this sheet would be that it would be used as a template.

This will prompt for the number of columns required

Sub AddColumnsRequired()
    Dim oWs As Worksheet
    Dim rData As Range
    Dim iCol As Integer, iColsAdd As Integer, iX As Integer

    Const sCol As String = "Name"

    On Error GoTo the_end
    Application.ScreenUpdating = False
    Set oWs = ThisWorkbook.Sheets("Sheet1")
    Set rData = oWs.Range("A1").CurrentRegion
    iCol = rData.Rows(1).Find(sCol).Column
    iColsAdd = Application.InputBox("Enter the number of columns to add")
    If iColsAdd < 1 Then
        MsgBox "No Columns entered. Cannot complete", vbCritical, "Quitting"
        GoTo the_end
    Else
        For iX = 1 To iColsAdd
            rData.Cells(1, iCol).EntireColumn.Insert
        Next iX
    End If
the_end:
    Application.ScreenUpdating = True
End Sub

Select allOpen in new window

You cannot really store the number of columns added,  using a similar method to delete columns could be problematic if the user deletes too many. Maybe, the added range could be stored within the workbook, or the user simply selects the columns to delete

If this is acceptable then it will simplify deleting the columns.

The amended code adds a header to each new Column -"Temp1", "Temp2", etc. It would simply be a case of finding these headers and deleting the columns

Sub InsertColumn()
    Dim oWs As Worksheet
    Dim rData As Range
    Dim iCol As Integer, iColsAdd As Integer, iX As Integer

    Const sCol As String = "Name"

    On Error GoTo the_end
    Application.ScreenUpdating = False
    Set oWs = ThisWorkbook.Sheets("Sheet1")
    Set rData = oWs.Range("A1").CurrentRegion
    iCol = rData.Rows(1).Find(sCol).Column
    iColsAdd = Application.InputBox("Enter the number of columns to add")
    If iColsAdd < 1 Then
        MsgBox "No Columns entered. Cannot complete", vbCritical, "Quitting"
        GoTo the_end
    Else
        For iX = 1 To iColsAdd
            rData.Cells(1, iCol + 1).EntireColumn.Insert
            rData.Cells(1, iCol + 1) = "Temp" & iX

        Next iX
    End If
the_end:
    Application.

Select allOpen in new window

ScreenUpdating = True
End Sub

This includes code to delete the temporary columns

Option Explicit
Dim oWs As Worksheet
Dim rData As Range
Dim iX As Integer
Const sTemp As String = "Temp"
Sub InsertColumn()
    Dim iCol As Integer, iColsAdd As Integer
    Const sCol As String = "Name"

    On Error GoTo the_end
    Application.ScreenUpdating = False
    Set oWs = ThisWorkbook.Sheets("Sheet1")
    Set rData = oWs.Range("A1").CurrentRegion
    iCol = rData.Rows(1).Find(sCol).Column
    iColsAdd = Application.InputBox("Enter the number of columns to add")
    If iColsAdd < 1 Then
        MsgBox "No Columns entered. Cannot complete", vbCritical, "Quitting"
        GoTo the_end
    Else
        For iX = 1 To iColsAdd
            rData.Cells(1, iCol + 1).EntireColumn.Insert
            rData.Cells(1, iCol + 1) = sTemp & iX

        Next iX
    End If
the_end:
    Application.ScreenUpdating = True
End Sub


Sub DeleteTempColumns()
    Dim rCl As Range
    On Error GoTo the_end
    Application.ScreenUpdating = False

    Set oWs = ThisWorkbook.Sheets("Sheet1")
    Set rData = oWs.Range("A1").CurrentRegion

    For iX = rData.Columns.Count To 1 Step -1
        If Left(rData.Cells(1, iX).Value, 4) = sTemp Then rData.Cells(1, iX).EntireColumn.Delete
    Next iX

the_end:
    Application.ScreenUpdating = True

End Sub

Select allOpen in new window

EDIT: added example workbook
EE-Inserting-Columns.xlsm

Hi Kailash,

Sorry for delay, I was away.
Try below:

Sub InsertColumn()
Dim Ws As Worksheet
Dim SpecificHeader As Range, WrkgHeader As Range
Dim ReqCol As Integer, i As Integer
Set Ws = ThisWorkbook.Worksheets("Sheet1")
Set SpecificHeader = Ws.Rows(1).Find(What:="Name", After:=Ws.Cells(1, 1))
Set WrkgHeader = Ws.Rows(1).Find(What:="Working *", After:=Ws.Cells(1, 1))
If Not WrkgHeader Is Nothing Then
    MsgBox "Working Columns already exist, first delete those columns and retry inserting columns", vbExclamation
    Exit Sub
End If
ReqCol = InputBox("How many Columns to be inserted?", Default:=1)
Application.ScreenUpdating = False
For i = ReqCol To 1 Step -1
        SpecificHeader.Offset(, 1).Resize(i).EntireColumn.Insert
        SpecificHeader.Offset(, 1).Value = "Working " & i
        SpecificHeader.Offset(, 1).EntireColumn.AutoFit
Next i
Application.ScreenUpdating = True
End Sub

Sub DeleteColumn()
Dim Ws As Worksheet
Dim SpecificHeader As Range
Set Ws = ThisWorkbook.Worksheets("Sheet1")
Application.ScreenUpdating = False
Do
    Set SpecificHeader = Ws.Rows(1).Find(What:="Working *", LookIn:=xlValues, LookAt:=xlPart)
    If SpecificHeader Is Nothing Then Exit Do
    SpecificHeader.EntireColumn.Delete
Loop
Application.ScreenUpdating = True
End Sub

Select allOpen in new window

Check in attached...where users are asked to enter number of columns to be inserted, if your working columns already exist, it will prompt user to first delete those columns and insert again.
KailashKapal_InsertDeleteColumn_v2.xlsm

Hi All,

Unfortunately, my requirement has been changed slightly.

Requirement : Enter value of number of rows required in Sheet1 and it gets inserted in next sheet . Similarly, if user changes the value of number of rows in Sheet1, the number of rows changes automatically.

For e.g. If user enters values as 2, it should insert number of columns in sheet2. Similarly if the user changes his mind and enters value as 3, it should insert number of columns in Sheet2.

I have attached the requirement sheet for your reference.
Requirement.xlsx

Hi Kailash,

Paste below code in Sheet1:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ws As Worksheet
Dim SpecificRng As Range, SpecificHeader As Range
Dim ReqCol As Integer, i As Integer
Set Ws = ThisWorkbook.Worksheets("Sheet2")
Set SpecificRng = Ws.Range("I5")
Application.ScreenUpdating = False

If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
If Target.Address = "$B$3" Then
    If IsNumeric(Target) Then
    On Error Resume Next
    Do
        Set SpecificHeader = Ws.Rows(5).Find(What:="Week *", LookIn:=xlValues, LookAt:=xlPart)
        If SpecificHeader Is Nothing Then Exit Do
        SpecificHeader.EntireColumn.Delete
    Loop
    ReqCol = Target.Value
        For i = ReqCol To 1 Step -1
            SpecificRng.Offset(, 1).Resize(i).EntireColumn.Insert
            SpecificRng.Offset(, 1).Value = "Week " & i
            SpecificRng.Offset(, 1).EntireColumn.AutoFit
        Next i
    End If
End If
Ws.Activate
Ws.Range("J5").Activate
Application.ScreenUpdating = True
End Sub

Select allOpen in new window

Change the value in Sheet1 B3, it will automatically delete previous Week's columns and add new columns with Week numbers in a sequence in Sheet2
KailashKapal_InsertColumns_v1.xlsm

Do you now need to add rows as well?

@Roy : The sheet provided by Shums is very near to my requirement. Thanks for your efforts.

So what's wrong with my code?

@Shums : There is one more requirement here.

Requirement details : Once we update the value in number of weeks in Sheet 1, two new columns would be created. There should be a sum total column calculated based on values entered in the Sheet 2.  If we again update the number of weeks in Sheet 1 , suppose we enter 3, then week1, week2, week3 should be there alongwith the values and the sum total should be calculated accordingly.

If we enter 4 in number of weeks, it should insert Week1 , week2, week3 and week4 in sheet2 alongwith Sum total value.
If we enter 3 in number of weeks, it should insert Week1 , week2, week3 in sheet2 alongwith Sum total value.

Also if i am entering a start date in Sheet 1, then Week 1 should start from that date and so on.
I would also have an end date in SHeet 1, which will be auto calculated from the value that i insert in number of weeks field.
KailashKapal_InsertColumns_v1.xlsm

Sorry Kailash,

Refer to this thread from the beginning.
You are changing your requirement the 3rd time.
Please be specific in your question from the beginning.
Your last requirement is not clear.
What will be the sum values? Where those values be?
What Start Date & End Date has to do in Sheet2? You'v not mentioned anything in your sample.

Sorry Shums, if i have been not clear in my previous comment. This would be my final requirement.

I have removed the Sum total value which i will take care myself.

Requirement details :

Requirement # 1 - Once we update the value in number of weeks in Sheet 1, two new columns would be created. There should be a sum total column calculated based on values entered in the Sheet 2.  If we again update the number of weeks in Sheet 1 , suppose we enter 3, then week1, week2, week3 should be there alongwith the values and the sum total should be calculated accordingly.

Requirement # 2 - If we enter 4 in number of weeks, it should insert Week1 , week2, week3 and week4 in sheet2 .
If we enter 3 in number of weeks, it should insert Week1 , week2, week3 in sheet2 .

Requirement # 3 - If i am entering a start date in Sheet 1, then Week 1 should start from that date and so on. For e.g. If i enter 09th JUly 2018 as the start date, then the Week1 column header should have "Week 1 09/07/18" and so on.

Let me know if you still have any queries related to the requirement.
KailashKapal_InsertColumns_v1.xlsm