
VBA: A Few Tips
Simple VBA

Below is some simple VBA code which you can use for a variety of purposes. Starting with these simple building blocks it is possible to build both your confidence, knowledge and ability to work with VBA completing complex appearing sub-routines.
Please revisit the site over the next few days and weeks as more content and helpful code is added.
Delete a Row or Column
The below sub-routine will delete the second row on the active sheet, and the second (B) column. Thirdly a row two below the currently active cell is deleted. This can easily be applied to columns.
Here is the code...
Sub DeleteRowAndColumn ()
' This deletes row 2 and column B from the active sheet
Rows(2).EntireRow.Delete
' Now delete the column
Columns("B").EntireColumn.Delete
' Delete a row 2 below the active cell
ActiveCell.Offset(2,0).EntireRow.Delete
End Sub
This code removes the specified rows and columns, and a row relating to the current active position.
Return to the TOP
Delete Cell Contents
There are two options that need to be considered when deleting a cell or range. Will removing the cell (or range) in its entirety affect other contents of the sheet, perhaps it would often when working with Excel you will want to add a new sheet to the workbook and make calculation on it. This first step is to add a sheet to a specified location and name the sheet as appropriate.
Sub DeleteContents ()
' This clears the contents of a single cell
End Sub
Note that we have used an error handling procedure in this code to account for the sub-routine being run on more than one occasion per day.
Return to the TOP
Create a Pivot Table
This code will create a pivot table adding a heading (correctly called a "Page Field"). To complete this process various items are required such as sheets as named within the sub-routine and data.
Here is the code...
Sub CreateAPivotTable()
Dim wsDest As Worksheet
Dim wsData As Worksheet
Dim rSource As Range
Dim rDest As Range
Dim rStart As String
Dim lRow As Long
Dim lCol As Long
Dim sName As String
Dim sPivName As String
sName = "Pivot"
sPivName = "NewPivot"
Application.DisplayAlerts = False
On Error Resume Next
Set wsData = Sheets("Data")
If Not wsData Is Nothing Then
'sheet exists no action required
Else
Call AddDataSheet
End If
rStart = "b17" 'wsdata.Range("b17")
Sheets("Pivot").Delete
On Error GoTo 0
Sheets.Add after:=Sheets("Data")
With ActiveSheet
.Name = sName
End With
Application.DisplayAlerts = True
Set wsDest = Worksheets("Pivot")
With wsData
lRow = .Range(rStart).End(xlDown).Row
lCol = .Range(rStart).End(xlToRight).Column
Set rSource = .Range(rStart, .Cells(lRow, lCol))
End With
Set rDest = wsDest.Range("A2")
ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=rSource, _
Version:=xlPivotTableVersion15).createpivottable _
TableDestination:=rDest, _
TableName:=sPivName, _
DefaultVersion:=xlPivotTableVersion15
With wsDest.PivotTables(sPivName)
.ColumnGrand = False
.RowGrand = False
.PivotFields("Month").Orientation = xlRowField
.PivotFields("Region").Orientation = xlPageField
.PivotFields("Product").Orientation = xlPageField
.PivotFields("Name").Orientation = xlColumnField
.PivotFields("Sales").Orientation = xlDataField
End With
End Sub
This code intentionally does not include totals for either rows or columns. Later developments will show how to add calculated fields to your pivot tables.
Return to the TOP
Split Some Text
Often when referring to data multiple items have been handily concatenated into a single cell. So here is a way to separate the items back into their constituent parts, and place these items in a range of cells. This process can also be used to populate Combo or List Boxes.
Sub SplitText ()
' This splits data found in a single cell and places it in an range
'A1 contents: Names
'B1 contents: Dusty Roads|Harry Bow|Joe King|Justin Time|Theresa Green
'A2 contents: Separator
'B2 contents: |
Dim sSeparator As String
Dim sNamesList As String
Dim vNames As Variant
sNamesList = ActiveSheet.Range("B1")
sSeparator = ActiveSheet.Range("B2")
' if the seperator is the last character remove it
If Right(sNamesList, 1) = sSeparator Then
sNamesList = Left(sNamesList, Len(sNamesList) - 1)
Else
' no need to do anything
End If
vNames = Split(sNamesList, sSeparator)
For i = 0 To UBound(vNames)
Cells(i + 1, 4).Value = vNames(i)
Next i
End Sub
Note that you can position the output text as you prefer. The separator character could be collected from the user via an input box if you wish or hard coded into the sub-routine (not recommended for flexibility).
Return to the TOP
Updating

Currently this site is under re-construction and this page amongst many is constantly being updated with information. Please revisit the site over the next few days and weeks as we add more content.