• Home
  • Other Stuff
  • Contact
Black Tor

VBA: A Few Tips

Simple VBA

Excel 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 Up Arrow

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 Up Arrow

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 Up Arrow

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 Up Arrow

Updating

Working on it!

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.