• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Insert columns based on input value in C3

Thomas Kuriakose

Active Member
Dear Sir,

We have a worksheet in which we need to automate the number of column entries based on the number of units required.
The cells in each row have formulas based on input parameters and subtotals. The requirement is to insert defined number of columns based on the units required (can be input box or cell reference) which should result in copying all formulas and formats to all columns inserted and also changing the total column value.

The inserted columns should be before the last three columns namely Total, Budget and Variance and after column E.

For example if the number of units entered in C3 is 4, then the number of columns inserted from column F should be 4 until column I. The Total Column, Budget and Variance should come after Column I

The below code was provided by Thau Theme Sir and it is working if the column of Units is just after C3, but since there are additions of columns to the sheets it is not working now.
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

Kindly help with the correct code for this.

Thank you so much,

with regards,
thomas
 

Attachments

  • Addtion and Subtraction of Columns based on cell input-2.xlsm
    23 KB · Views: 4
Dear Sirs,

I have worked on the code and happy to say that now this is working partially. The columns are getting inserted but I am not able to get the totals columns automated based on the input columns.

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 - 3
If LC = 6 Then
    If Target.Value = 1 Then
        Exit Sub
    Else
        For I = 2 To Target.Value
            Columns(6).Copy
            Columns(I + 5).Insert Shift:=xlToRight
            Cells(2, I + 5).Value = "Unit " & I
            Cells(3, I + 5) = I
        Next I
    End If
    Application.CutCopyMode = False
    Exit Sub
End If
Range(Cells(2, 7), Cells(2, LC)).EntireColumn.Delete
For I = 2 To Target.Value
    Columns(6).Copy
    Columns(I + 5).Insert Shift:=xlToRight
    Cells(2, I + 5).Value = "Unit " & I
    Cells(3, I + 5) = I
Next I
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Kindly help with a code to get the totals column added up based on the number on input columns.

Thank you so much.

with regards,
thomas
 

Attachments

  • Addtion and Subtraction of Columns based on cell input-3.xlsm
    24.3 KB · Views: 9
Dear Sirs,

I found a code on the net for adding row values.

Code:
Sub Alternate_columns()
Range("E:E").Select
Dim ColumnToInsert As Long
Dim loopcount As Long
ColumnToInsert = Range("D14")
If ColumnToInsert > 0 Then
    For loopCounter = 1 To ColumnToInsert
Range("E:E").EntireColumn.Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    Next
  End If
 
Range.Select("new cell with Total", ColumnToInsert).FormulaR1C1 = "=IF(SUM(RC[-4]:RC[-ColumnToInsert])=0,"""",SUM(RC[-4]:RC[-ColumnToInsert]))"

End Sub

Kindly let me know how to incorpaorate this in the code of the insert columns to get the sum of the total columns.

Thank you so much,

with regards,
thoms
 
Dear Sirs,

Kindly let me know how to dynamically get the summation of columns based on the number of units entered.

Currently the total column is showing SUM(F23:F23) for a particular row.

The sum should reference the column F(start) and the 3rds last column based on the number of units entered.

Thank you so much,

with regards,
thomas
 
@Luke M , kindly provide a code to get the summation in the totals column, based on the numbers of columns for he units entered.

Thank you so much,

with regards,
thomas
 
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngHave As Long
Dim lngWant As Long

'Check if macro should run
If Intersect(Target, Range("C3")) Is Nothing Then Exit Sub

'Define our boundary conditions
lngWant = Range("C3").Value
If lngWant <= 0 Then
    MsgBox "Value must be greater than 0.", vbOKOnly, "Invalid input"
    Exit Sub
End If
'Subtract 3 for the total columns, and 5 for the header columns
lngHave = Cells(2, Columns.Count).End(xlToLeft).Column - 3 - 5

'Turn these off since we're about to make changes
Application.ScreenUpdating = False
Application.EnableEvents = False

'Determine what we need to do
If lngHave = lngWant Then
    'Do nothing
ElseIf lngHave > lngWant Then
    'Need to subtract columns
    Do
        Range("F2").Offset(, lngHave - 1).EntireColumn.Delete
        lngHave = lngHave - 1
    Loop Until lngHave = lngWant
Else
    'Need to add columns
    Do
        Range("F2").EntireColumn.Copy
        Range("F2").Offset(0, 1).EntireColumn.Insert shift:=xlToRight
        lngHave = lngHave + 1
    Loop Until lngHave = lngWant
End If

'Update column headers
If lngWant > 1 Then
    Range("F2").AutoFill Destination:=Range("F2").Resize(1, lngWant), Type:=xlFillSeries
    Range("F3").AutoFill Destination:=Range("F3").Resize(1, lngWant), Type:=xlFillSeries
End If

'Update Total column formulas
Range("F2").Offset(0, lngWant).EntireColumn.SpecialCells(xlCellTypeFormulas).FormulaR1C1 = _
    "=SUM(RC6:RC[-1])"

Application.CutCopyMode = False
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
 
Respected Sir,

This is perfect.

Thank you so much for the code and for the help in completing this task.

Thanks you once again,

with regards,
thomas
 
Back
Top