Add and Subtract columns based on cell value

[Thomas Kuriakose]

Dear All,

We have the attached sheet where the total units are entered in cell C3, based on the value entered the no. of columns should be added or removed with the header data and the corresponding value of the unit number.

Kindly help with a solution to get this result.

Thank you so much,

with regards,
thomas

 

[ThauThème]

Hi Thomas,

Really, my english is pretty poor. But despite this, I have absolutely not understood what you wanted to add or subtract! Could you explain better?

 

[Thomas Kuriakose]

Dear Thau,

Sorry for not proving the correct explanation

If the cell entry in C3 is value 20, then we should get 20 units, which means 20 columns starting from D2
If the entry in cell C3 is 5, then we should have 5 units, which means 5 columns from D2.

The inserted columns should have all the rows as the previous including the respective unit no.

Thank you so much.

with regards,
thomas

 

[ThauThème]

Hi Thomas,

Try this code :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LC As Integer
Dim I As Integer

Application.ScreenUpdating = False
If Target.Address <> "$C$3" Then Exit Sub
If Target.Value = "" Or Target.Value = 0 Then MsgBox "Value must be superior to 0": Exit Sub
LC = Cells(2, Application.Columns.Count).End(xlToLeft).Column
If LC = 4 Then
    If Target.Value = 1 Then
        Exit Sub
    Else
        For I = 2 To Target.Value
            Columns(4).Copy Cells(1, I + 3)
            Cells(2, I + 3).Value = "Unit " & I
            Cells(3, I + 3) = I
        Next I
    End If
    Exit Sub
End If
Range(Cells(2, 5), Cells(2, LC)).EntireColumn.Delete
For I = 2 To Target.Value
    Columns(4).Copy Cells(1, I + 3)
    Cells(2, I + 3).Value = "Unit " & I
    Cells(3, I + 3) = I
Next I
Application.ScreenUpdating = True
End Sub

 

[Thomas Kuriakose]

Dear Thau,

This is simply awesome. Thank you so much for the solution provided.

Thank you once again.

with regards,
thomas

 

[Thomas Kuriakose]

Dear Thau,

We require an additional code to prevent deletion of the last column (Total column) when adding or deleting columns.

Kindly find attached the sheet for your reference.

thanks so much.

with regards,
thomas

 

[ThauThème]

Hi Thomas,

Sorry for the delay...
Here is the modified code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LC As Integer
Dim I As Integer

Application.ScreenUpdating = False
If Target.Address <> "$C$3" Then Exit Sub
If Target.Value = "" Or Target.Value = 0 Then MsgBox "Value must be superior to 0": Exit Sub
LC = Cells(2, Application.Columns.Count).End(xlToLeft).Column
If LC = 5 Then
    If Target.Value = 1 Then
        Exit Sub
    Else
        For I = 2 To Target.Value
            Columns(4).Copy
            Columns(I + 3).Insert Shift:=xlToRight
            Cells(2, I + 3).Value = "Unit " & I
            Cells(3, I + 3) = I
        Next I
    End If
    Application.CutCopyMode = False
    Exit Sub
End If
Range(Cells(2, 5), Cells(2, LC - 1)).EntireColumn.Delete
For I = 2 To Target.Value
    Columns(4).Copy
    Columns(I + 3).Insert Shift:=xlToRight
    Cells(2, I + 3).Value = "Unit " & I
    Cells(3, I + 3) = I
Next I
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[Thomas Kuriakose]

Dear Thau,

Thank you so much for the new code provided.

Thanks a ton for this help.

with regards,
thomas

 

[Thomas Kuriakose]

Dear Thau,

One more query on this.

If we insert a column between C & E and shift the input cell to D3, which part of the code will change.

Thank you so much.

with regards,
thomas

 

[ThauThème]

Hi Thomas,

The new code :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LC As Integer
Dim I As Integer

Application.ScreenUpdating = False
If Target.Address <> "$D$3" Then Exit Sub
If Target.Value = "" Or Target.Value = 0 Then MsgBox "Value must be superior to 0": Exit Sub
LC = Cells(2, Application.Columns.Count).End(xlToLeft).Column
If LC = 6 Then
    If Target.Value = 1 Then
        Exit Sub
    Else
        For I = 2 To Target.Value
            Columns(5).Copy
            Columns(I + 4).Insert Shift:=xlToRight
            Cells(2, I + 4).Value = "Unit " & I
            Cells(3, I + 4) = I
        Next I
    End If
    Application.CutCopyMode = False
    Exit Sub
End If
Range(Cells(2, 6), Cells(2, LC - 1)).EntireColumn.Delete
For I = 2 To Target.Value
    Columns(5).Copy
    Columns(I + 4).Insert Shift:=xlToRight
    Cells(2, I + 4).Value = "Unit " & I
    Cells(3, I + 4) = I
Next I
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

What change :
• If Target.Address <> "$D$3" Then Exit Sub
• If LC = 6 Then

• Columns(5).Copy
• Columns(I + 4).Insert Shift:=xlToRight
• Cells(2, I + 4).Value = "Unit " & I
• Cells(3, I + 4) = I
Two times

• Range(Cells(2, 6), Cells(2, LC - 1)).EntireColumn.Delete

 

[Thomas Kuriakose]

Dear Thau,

Thanks a ton for the new code and the clarification on the changes.

Thanks so much once again.

with regards,
thomas