Add a new column to Excel Table using VBA

Add Columns to Excel List Object using VBA / Add a new column to Excel Table using VBA

As discussed in previous blog posts, one of the ‘sleek’ advantage that a listobject gives us is to treat it as a datasource/ a data table. Here we can experience the same in adding a new column, which gets data from existing columns

Sub Add_ListColumn_2_ExistingTable()

Dim oWS As Worksheet ' Worksheet Object

Dim oRange As Range ' Range Object - Contains Represents the List of Items that need to be made unique

Dim oLst As ListObject ' List Object

Dim oLC As ListColumn ' List Column Object

On Error GoTo Disp_Error

' ---------------------------------------------

' Coded by Shasur for www.vbadud.blogspot.com

' ---------------------------------------------

oWS = ActiveSheet

If oWS.ListObjects.Count = 0 Then Exit Sub

oLst = oWS.ListObjects(1)

oLC = oLst.ListColumns.Add

oLC.Name = "Total Price"

oLC.DataBodyRange = "=[Price]*[Availability]"

If Not oLC Is Nothing Then oLC = Nothing

If Not oLst Is Nothing Then oLst = Nothing

If Not oWS Is Nothing Then oWS = Nothing

' --------------------

' Error Handling

' --------------------

Disp_Error:

If Err <> 0 Then

MsgBox(Err.Number & " - " & Err.Description, vbExclamation, "VBA Tips & Tricks Examples")

Resume Next

End If

End Sub

Excel List before Column Addition
Excel List after Column Additon (Note the column values are generated automatically)

The new column ‘Total Price’ is added to the existing Table and all the rows are calculated without any hassles

Refer (http://vbadud.blogspot.com/2008/07/convert-range-to-listobject-using-excel.html) for creating ListObjects in Excel

Dynamic Copy of Matching Excel Data

Copy specific data in cells from Master Sheet to Current Sheet

Most often we would have the entire data in Excel and would require data corresponding to the cell value taken from the master sheet and populated in the current one dynamically.

In the following example the master sheet is named as "DB" and contains all records with the primary key being the first column.

Function Snippet_For_Copy(sSearchString)

If Trim(sSearchString) = "" Then Exit Function

With Sheets("DB").Columns("A:A")
Set rFindCell = .Find(sSearchString, LookIn:=xlValues, LookAt:=xlWhole)
If Not rFindCell Is Nothing Then
Sheets("DB").Rows(rFindCell.Row).EntireRow.Copy _
Destination:=Range("A" & ActiveCell.Row)
End If
End With

End Function

If the user enters a data in the first column of the current sheet, the above function will check the data in the DB sheet and transfer entire row if a match is found

You can trigger the function using Worksheet_SelectionChange event

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If IsNumeric(Target) = False Then Exit Sub
If Trim(Target) = "" Then Exit Sub

Application.EnableEvents = False

Snippet_For_Copy Target.Value

Application.EnableEvents = True
End Sub