How to use VBA code to add columns in excel
Category: [Excel] Demo Available
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
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.
Obtained from the OzGrid Help Forum.
Solution provided by sktneer.
See also: Index to Excel VBA Code and Index to Excel Freebies and Lesson 1 - Excel Fundamentals and Index to how to… providing a range of solutions and Index to new resources and reference sheets
See also:
| How to count and delete duplicate entries over multiple columns |
| How to use VBA to change zero value to blank value based on criteria in other columns |
| How to copy columns from multiple workbooks and paste into one worksheet |
| How to create VBA to split data to their respective columns with character restriction |
Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.