- Home
Welcome !
This is the website for Black Tor Consulting Ltd, we would like to offer you some help with your technology issues.
Mainly on this site we focus on Microsoft Excel formulas, VBA automation of workbooks and website design.
Cross Browser Support
This site has been tested in all major browsers.
Compatible Browsers
- Internet Explorer
- Firefox
- Opera
- Chrome
- Safari
- What else ?
- Other Stuff
Pages of Interest
Book Covers We Have Created
Ghosts from Afghanistan: A complex cover combining eight different images each layered onto a smokey background. Additional images were wrapped around the mannequin to give an interesting perspective.
Read more...
The Escape of Jack the Ripper: This cover has a more modern appearance. Colour washes and again multiple images were required to build the final cover image which can be seen here.
Read more... - Contact
Contact Us
Please fill in the following form to contact us
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.
