How to VBA code to add columns in excel

How to use VBA code to add columns in excel

Requirement:

The user needs help coming up with the code that adds a new column based off different conditions listed below. The user has attached an excel file that the user will use to explain what they are looking for.

"Sheet1" will be the affected sheet that needs the code
On the click of a button, a new column should be added and it's header title should be whatever is in B1, hours. For example if B1 is "Low" the new column added should have a header saying "Low hours" in F6
The column added should start from Column F
The header for the new column should be at F6
On the click of the button, a new column should always be added with the header title described
If there will be a new column that would have the same header as a previous column, an option to decide if this a duplicate or a new test. If it's a duplicate, then the old column should be selected but if it's a new test, then a new column should be created. However, the new column should have some kind on separator. For example, instead of having two columns with headers "Low hours", the second column should be "Low hours 2"
On the back end there should be a column that keeps a total of all the hours collected by rows. This will be in column E. The total should automatically be updated as other test hour columns are updated

https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/1204754-vba-code-to-add-columns-in-excel

Solution:

Place the following code on a Standard Module like Module1.

Code:

Sub AddColumn()
Dim lc As Long, headerCnt As Long
Dim header As String
Dim c
Dim Ans As VbMsgBoxResult

Application.ScreenUpdating = False
Application.EnableEvents = False
lc = Cells(6, Columns.Count).End(xlToLeft).Column + 1
header = Range("B1").Value & " Hours"
c = Application.Match(header, Rows(6), 0)
If IsError(c) Then
    Cells(6, lc) = header
Else
    Ans = MsgBox("The column " & header & " already exists." & vbNewLine & vbNewLine & _
                "Click on YES if it is a New Test else click on NO.", vbQuestion + vbYesNo, "Confirm Please!")
    If Ans = vbNo Then
        Cells(6, c).Select
    Else
        headerCnt = Application.CountIf(Rows(6), header & "*")
        header = Range("B1").Value & " Hours " & headerCnt + 1
        Cells(6, lc) = header
    End If
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Place the following code on Sheet1 Module.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Dim lc As Long, r As Long
On Error GoTo Skip
If Target.Column > 5 And Target.Row > 6 Then
    If Cells(6, Target.Column) <> "" Then
        Application.EnableEvents = False
        r = Target.Row
        lc = Cells(r, Columns.Count).End(xlToLeft).Column
        Cells(r, 5).Value = Application.Sum(Range(Cells(r, 6), Cells(r, lc)))
    End If
End If
Skip:
Application.EnableEvents = True
End Sub

For more details, refer to the attached.

https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/1204754-vba-code-to-add-columns-in-excel

Obtained from the OzGrid Help Forum.

Solution provided by sktneer.