I have no experience in Visual Basic and I am trying to add or delete columns based on a cell value while keeping the same format from the first column. I´ve seen some posts but my programming knowledge is very basic and I can´t find a way to adjust variables for it to fit into my file.

The following code seems to work for the post I read but as I said I don´t know what to change for it to work in my file:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range, ColNum As Long, TotalCol As Long, LeftFixedCol As Long
Dim Rng As Range, c As Range
Set KeyCells = Range("B1")
If Application.Intersect(KeyCells, Target) Is Nothing Then Exit Sub
If IsNumeric(KeyCells.Value) = False Then Exit Sub
ColNum = KeyCells.Value
If ColNum <= 0 Then Exit Sub
Set Rng = Range(Cells(3, 1), Cells(3, Columns.Count))
Set c = Rng.Find("Total")     'the find is case senseticve, Change "Total" to desired key word to find
If c Is Nothing Then Exit Sub
TotalCol = c.Column
LeftFixedCol = 2          'Column A & B for Company and ID

Dim i As Integer
If TotalCol < LeftFixedCol   ColNum   1 Then ' Add column
        For i = TotalCol To LeftFixedCol   ColNum
        Columns(i).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        Cells(3, i).Value = "Column " & i - LeftFixedCol ' may not use this line
        Next i
End If
If TotalCol > LeftFixedCol   ColNum   1 Then ' Add column
        For i = TotalCol - 1 To LeftFixedCol   ColNum   1 Step -1
            Columns(i).Delete
        Next i
End If
End Sub

Is it too much to ask if somebody could please help identifying each code line or give me a more simple code to work with? The following gif shows exactly what I am trying to do:

Thanks beforehand!

CodePudding user response：

A Worksheet Change: Insert or Delete Columns

• This code mustn't be copied into a standard module, e.g. Module1 as you did.
• It needs to be copied into a sheet module, e.g. Sheet1, Sheet2, Sheet3 (the names not in parentheses), of the worksheet where you want this to be applied. Just double-click on the appropriate worksheet in the Project Explorer window (seen on the top-left of your screenshot), copy the code to the window that opens and exit the Visual Basic Editor.
• The code runs automatically as you change the values in the target cell (B1 with this setup) i.e. you don't run anything.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    On Error GoTo ClearError
    ' e.g. to prevent
    ' "Run-time error '1004': Microsoft Excel can't insert new cells because
    '  it would push non-empty cells off the end of the worksheet.
    '  These non-empty cells might appear empty but have blank values,
    '  some formatting, or a formula. Delete enough rows or columns
    '  to make room for what you want to insert and then try again.",
    ' which is covered for the header row, as long there is nothing
    ' to the right of the total column, but not for other rows.
   
    Const TargetCellAddress As String = "B1"
    Const TotalFirstCellAddress As String = "D3"
    Const TotalColumnTitle As String = "Total" ' case-insensitive
    
    Dim TargetCell As Range
    Set TargetCell = Intersect(Me.Range(TargetCellAddress), Target)
    If TargetCell Is Nothing Then Exit Sub ' cell not contained in 'Target'
    
    Dim NewTotalIndex As Variant: NewTotalIndex = TargetCell.Value
    
    Dim isValid As Boolean ' referring to an integer greater than 0
    
    If VarType(NewTotalIndex) = vbDouble Then ' is a number
        If Int(NewTotalIndex) = NewTotalIndex Then ' is an integer
            If NewTotalIndex > 0 Then ' is greater than 0
                isValid = True
            End If
        End If
    End If
    
    If Not isValid Then Exit Sub
    
    Dim hrrg As Range ' Header Row Range
    Dim ColumnsDifference As Long
    
    With Range(TotalFirstCellAddress)
        Set hrrg = .Resize(, Me.Columns.Count - .Column   1)
        If NewTotalIndex > hrrg.Columns.Count Then Exit Sub ' too few columns
        ColumnsDifference = .Column - 1
    End With
    
    Dim OldTotalIndex As Variant
    OldTotalIndex = Application.Match(TotalColumnTitle, hrrg, 0)
    If IsError(OldTotalIndex) Then Exit Sub  ' total column title not found
    
    Application.EnableEvents = False
    
    Dim hAddress As String
    
    Select Case OldTotalIndex
    Case Is > NewTotalIndex ' delete columns
        hrrg.Resize(, OldTotalIndex - NewTotalIndex).Offset(, NewTotalIndex _
            - ColumnsDifference   2).EntireColumn.Delete xlShiftToRight
    Case Is < NewTotalIndex ' insert columns
        With hrrg.Resize(, NewTotalIndex - OldTotalIndex) _
                .Offset(, OldTotalIndex - 1)
            ' The above range becomes useless after inserting too many columns:
            hAddress = .Address
            .EntireColumn.Insert Shift:=xlToRight, _
                CopyOrigin:=xlFormatFromLeftOrAbove
        End With
        With Me.Range(hAddress)
            .Formula = "=""Column""&COLUMN()-" & ColumnsDifference - 1
            .Value = .Value
        End With
    Case Else ' is equal; do nothing
    End Select
    
SafeExit:
    If Not Application.EnableEvents Then Application.EnableEvents = True
    
    Exit Sub
ClearError:
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    Resume SafeExit
End Sub