Xcel VBA Macros

I found it a great source of frustration recently when trying to create a VBA application within Microsoft Excel - I have a fairly comprehensive knowledge of VB, but not really any experience within the VBA environment and the commands available. I had a list of “data” which i split into sub lists, formated, cross referenced, cross referenced external files, split further and printed. This was a daily task which took 40-50 mintutes - and i wanted to automate it.

There was a large amount of seaching involved to find the commands I needed so I have compiled them here:

Firstly there was some formatting to tidy up:

‘Delete the first 12 rows (who puts 12 blank rows at the beginning of a spreadsheet?!)
Rows(”1:12″).Select
Range(”A12″).Activate
Selection.Delete Shift:=xlUp
‘Delete various surplus columns
Range(”C:C,D:D,F:G,J:L”).Select
Range(”J1″).Activate
Selection.Delete Shift:=xlToLeft
‘Make remaining columns wide enought for their contents
Columns(”A:E”).Select
Columns(”A:E”).EntireColumn.AutoFit

Preparing For Autofill Within Macro’s (Finding The Last Row)
I also needed to know how many rows there are - Excel VBA is desperately lacking in that the autofill function doesn’t behave how you would expect, when recording a macro it records the exact row at that time. This is obviously no good if you want to use data that has different numbers of rows, but the same basic structure.

To find the last row you need to know in advance which column you will have the most data in - a uniue key, names, etc something which will always be populated in a data containing row. You could run the following code for every column and then compare the values and keep the largest, but thats going to be kind of intensive - for me there is a job number in every populated row in column D, which is the column I’m using here. The code simply starts at the very end of the workbook and works its way up to the first data it hits (the last row), and returns the row value. Here we assign it to a new variable (or predefined if you prefer).

lastRow = Range("D65536").End(xlUp).Row

Creating Combined Keys / Autofill Formulas (within Macros) / Copy Column & Paste Values
The next problem I had occured because the data had no unique identifier - there were names and postcodes but more than one account could share a name and/or postcode. However a shared key could be created by combining the two.

Here the macro creates a new column and creates a formula to combine the two values. Its then copied down the column for as many rows as have text in them - that is, it fills every row that has data using our previously descovered lastRow value.

After this the macro copies the resulting formulas and pastes the values (otherwise the formulas would be constantly recalculated - crippling the performance).

Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A2").Select
ActiveCell.FormulaR1C1 = "=RC[2]&RC[4]"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A" & lastRow)
Range("A2:A" & lastRow).Select
Columns("A:A").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("A:A").EntireColumn.AutoFit

Operating On Visible Cells - Method 1 (Sloppy) BROKEN!!!
As the subtitle suggests there are two ways of performing an operation on visible cells. Visible cells are those cells that are still visible on screen after performing an auto filter or advanced filter within excel.

The first requires two range variables, the first of which is initally set to include all rows in all columns that contain data (A - G in this instance):

Dim rng As Range, TmpRng As Range
Set rng = Range("A1:G" & Range("G65536").Row)

Next, we perform the filter required - here field 5 denotes the 5th column, E. <> would denote “not equal” should we want to filter those that do not match eg “<>Criteria”. The code beneath then creates a new range (which is assigned to pre defined TmpRng variable) based on all visible cells in your range and deletes that temporary range, finally resetting it.

Selection.AutoFilter Field:=5, Criteria1:="Filter Criteria"
Set TmpRng = Intersect(rng.SpecialCells(xlCellTypeVisible), Range("E2:E65536"), ActiveSheet.UsedRange)
TmpRng.EntireRow.Delete
Set TmpRng = Nothing

This method is BROKEN. If the filter shows no results, the intersect will obviously result in nothing. This in turn means the script is trying to delete nothing and causes an error. There is probably a way to check if a range is empty/zero/null but i couldn’t find a way with 5 minutes of searching, and besides I’d already found the below method which is more elegent anyway. This methods probably only useful for learning more VBA, as opposed to having any real use in an application unless of course you know the filter will always return a value.

Operating On Visible Cells - Method 2 (Neat)
This is a much neater, easier, more logical method for operating on visible cells - however you must remember to select the range to begin with, essentially we are doing the same thing but using the default range rather than assigning it to variables. Here we:

  1. select column J
  2. filter J for non blanks
  3. select all rows that have data in them using (predefined) lastrow variable
  4. narrow this selection further to only visible cells
  5. delete all rows in selection
  6. show all data

This is a much more intuitive approach:

Columns("J:J").Select
Selection.AutoFilter Field:=10, Criteria1:="<>”
Range(”J2:J” & lastRow).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.EntireRow.Delete
ActiveSheet.ShowAllData

Speed Tips
The below two options will cause the screen to stop responding and prevent any interuptions - however, they speed up calculations which is always a bonus on a data intensive task (one 45 minute macro was reduced to 30mins)

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

There is a further speed tip that can be used - but it must be used with care. Its so dangerous, I tend to sidestep it! Application.Calculation can stop all formulas and sums from updating unless you trigger an update - when you have a sheet with three columns of formulae for example and you want to delete a series of cells or rows, for every action, all formula’s on the sheet will update. This is obviously a very serious handicap in terms of processing and time. By changing the calculation method to manual, you can prevent this automatic refreshing of values - particularly useful when your columns do not affect what you are doing.

  1. xlCalculationAutomatic - Excel controls recalculation.
  2. xlCalculationManual - Calculation is done when the user requests it.
  3. xlCalculationSemiautomatic - Excel controls recalculation but ignores changes in tables.

The drawback however occurs when you set the calculation method to manual too soon, and if you forget to turn it back to automatic. Its very easy to set the method to manual at the beggining of a process - but then every time you enter a formula or calculation (even something as simple as =2+3) you will have to remember to fire the calculation to update all formulas.

The easiest way around this is to do as I have done in all my code - use the formulas, and then cop and paste the values of the results. The only time this doesn’t work is when you need a formula to constantly update, but this happens rarely, and in these situations you can bookend any intensive code with switches to set calcualtions to manual and then automatic.

Assigning Sheets/Ranges to Variables
You can set variables for values, but you can also set variables to ranges and sheets, even workbooks. The below code gives you relevent examples for using variables as pointers to sheets, but you can replace the Sheet with relevent type name.

'set variables
Dim WS as Sheet, WSnew as Sheet

'Assign Sheet to variable
Set WS = Sheets("RequestHandler")

'Create new sheet and assign to variable directly
Set WSNew = Worksheets.Add
'can now refer to sheets by variable names
WSNew.Name = "Census"

Format Cells
You’ll recognise most of the options below from the Format Cells dialog in Excel - useful for changing wrapping and alignment options.

Range("H1:I1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Page Setup / Printing
The following code shows how to set up the page preferences, so that you can force page setup options on a document - great for setting margins or printing column headers on every printed page.


With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$2"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.196850393700787)
.RightMargin = Application.InchesToPoints(0.196850393700787)
.TopMargin = Application.InchesToPoints(0.196850393700787)
.BottomMargin = Application.InchesToPoints(0.196850393700787)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 4
.PrintErrors = xlPrintErrorsDisplayed
End With

And this piece of code sets a filter to show predefined values (you could use variables, CriteriaX:=VariableY for example) and then prints the active sheet - note the print function works exactly like hitting the printer icon - no prompts, just printing. Also notice that print only prints visible cells by default.


Selection.AutoFilter Field:=1, Criteria1:="=A01", Operator:=xlOr, _
Criteria2:="=A02"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Postcodes to Postcode Districts to Areas
Turning postcodes into field areas based on postcode district provided a fairly straightforward problem…

Firstly I copy the postcodes (i still need to keep the postcodes for later) from column E to column A. I’m ultimately trying to discard the extra data and reduce the postcode into postcode districts. BN27 1DR > BN etc

Columns("E:E").Select
Selection.Copy
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Next select the new postcode column - we are now going to split the data inside to two new columns. The first column is fixed width to two characters and the second column will be discarded as we no longer need the data.


Columns("A:A").Select
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(2, 9)), TrailingMinusNumbers:=True

Now with the first two characters of any postcode, we need to remove the digits from one letter postcodes such as “S” or “L” - it’s easiest within a macro to run through each digit one at a time and remove every instance from the selection.


Selection.Replace What:="0", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

…

Selection.Replace What:="9", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Finally the postcode district needs to be grouped into predefined areas. Given a selection (highlighted group of cells) this method simply replaces every occurance of a particular string with another string. Essentially this is the VBA code for Find And Replace - i use this for converting the 40 postcode districts into 19 different discrete areas.

Selection.Replace What:="AB", Replacement:="Area 19", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Postcodes/Districts/Sectors to Predefined Areas Function
So above was a macro that would transform a static set of text - here is a function, which can be called much like any predefined function (like sum/vlookup etc) from the “User Defined” list in the innsert function finder.

This is a more elegent way of dealing with the problem, trimming the postcode as required and then using a case statement to output the new value.

Function Postcode2Area(Postcode As String) As String

If IsNumeric(Mid(Postcode, 2, 1)) Then
Postcode = UCase(Left(Postcode, 1))
Else
Postcode = UCase(Left(Postcode, 2))
End If

Select Case Postcode
Case "BA", "DT", "EX", "PL", "TA", "TQ", "TR"
Postcode2Area = "A01"
Case "BS", "CF", "GL", "HR", "LD", "NP", "SA", "SN"
Postcode2Area = "A02"
Case "B", "DY", "ST", "SY", "TF", "WR", "WS", "WV"
Postcode2Area = "A03"
Case "AL", "CV", "EN", "HP", "LU", "MK", "NN", "OX", "WD"
Postcode2Area = "A04"
Case "DE", "LE", "LN", "NG", "PE"
Postcode2Area = "A05"
Case "CB", "CM", "CO", "IP", "NR", "SG", "SS"
Postcode2Area = "A06"
Case "BN", "CT", "DA", "ME", "RH", "TN"
Postcode2Area = "A07"
Case "BH", "GU", "PO", "RG", "SL", "SO", "SP"
Postcode2Area = "A08"
Case "HA", "KT", "NW", "SM", "SW", "TW", "UB", "W"
Postcode2Area = "A09"
Case "BR", "CR", "E", "EC", "IG", "N", "RM", "SE", "WC"
Postcode2Area = "A10"
Case "CH", "CW", "L", "LL", "WA"
Postcode2Area = "A11"
Case "M", "OL", "SK", "WN"
Postcode2Area = "A12"
Case "BD", "HD", "HX", "S"
Postcode2Area = "A13"
Case "DN", "HU", "LS", "WF"
Postcode2Area = "A14"
Case "DL", "HG", "TS", "YO"
Postcode2Area = "A15"
Case "DH", "NE", "SR"
Postcode2Area = "A16"
Case "BB", "BL", "CA", "FY", "LA", "PR"
Postcode2Area = "A17"
Case "DG", "EH", "FK", "G", "KA", "KY", "ML", "PA", "TD"
Postcode2Area = "A18"
Case "AB", "DD", "HS", "IV", "KW", "PH", "ZE"
Postcode2Area = "A19"
Case Else
Postcode2Area = "Unknown"
End Select

End Function

3 Comments »

RSS feed for comments on this post. TrackBack URI

  1. kierandelaney.net / New Page wrote:

    […] Excel VBA Macros […]

    Posted on 02-Nov-07 at 2:33 pm | Permalink

  2. WaNieY wrote:

    hello

    can u show me the code to filter more than 2 criteria?i have a difficulty to do that. tanx a lot!=)

    Posted on 30-Jun-08 at 3:56 am | Permalink

  3. Frustrated wrote:

    Hello,
    I have been trying to create a macro on Excel that will take data from 3 worksheets ( 3 columns) and create a new list containing all the data from the three sources. Should be simple to do…but am having serious difficulties as I am new to VBA. I would greatly appreciate any suggestions regarding how to do this.
    Thanks :)

    Posted on 29-Jul-08 at 8:11 pm | Permalink

Leave a comment

XHTML: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong>

Powered by WordPress with GimpStyle Theme heavily modified by Kieran Delaney.
Entries and comments feeds. Valid XHTML and CSS. 20,414 spam comments ignored.