Excel Code Licks
Everyone has a toolbox of tools that they use to accomplish their jobs. Plumbers have pipe wrenches, Chemists have beakers and flasks, Doctors have stethoscopes and medical measuring devices. It is no surprise then that I maintain my own "bag of tricks" in code that I constantly re-use for my given Excel programming assignments. So, here are just a few of my favorite code licks for various purposes:
First, talking to the user (status bar messages)
Many of my Excel applications process hundreds of thousands of rows of data, or could be opening and closing up to a dozen external sheets in other files for processing. Some of my applications (like exploding 400 Bills of Materials in one pass) could take several minutes to complete. So, I like to let the user know what's going on and where the process is by pushing messages to the lower-left Status Bar. Here's some code:
Status bar on and off (do this first at the top of the Sub):
Application.DisplayStatusBar = True, False
Disable, enable alerts (make sure process doesn't stop with an Excel alert): Application.DisplayAlerts = True, False
Allowing screen updating:
Application.ScreenUpdating = True, False
Kill those pesky Update External Links warnings (so annoying...):
Kill those pesky Update External Links warnings (so annoying...):
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Pushing messages to status bar:
Application.StatusBar = "This is a message"
During processing, I always have screen updating off. So when it comes time to update the user, I (a) turn on screen updating, (b) push the message, and (c) turn screen updating off. Something like this:
Application.ScreenUpdating = True
Application.StatusBar = "Now loading Part 2..." Application.ScreenUpdating = False
Where's the last row? (I always declare the sheet name)
With Sheets("Sheet1")
lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
End With
Where's the last column? (This is trickier, pick a row that has all cells full)
Where's the last column? (This is trickier, pick a row that has all cells full)
lastcol = Sheets("ExpReceipts").Cells(3, Columns.Count).End(xlToLeft).Column
Now here's the pain in the neck part: Excel is not going to return the column name like "AX", its going to give you back a number (the column index) in this example (50). "AX" is the 50th column in Excel. Here's where it gets really messy. If you are working with a datasheet and must work from right to left... and the number of columns is always different with each run... then you'll need to test for the last column to the right, and you'll have to work with cell index numbers (like Cells (3,8)) instead of the nice, neat column,row ranges like .range("A1:D5"). This is where simple tasks like copy & paste become a challenge. Read on...
Range reference (Copy & Paste) with cell index numbers (I use for horizontal pasting)
Working with cell index number references is a little harder than the nice, neat column,row ranges like range("A1:D5"). But the real killer is the syntax. Any range or cell reference MUST be qualified by the workbook and sheet name. In a Copy & Paste example, this code and syntax has been the most reliable:
Dim RngSource As Range, RngTarget As Range
'get your last column
lastcol = Sheets("ExpReceipts").Cells(3, Columns.Count).End(xlToLeft).Column
'set the source range (maybe one cell, in this case B2)
With ThisWorkbook.Sheets("ExpReceipts")
Set RngSource = .Cells(1, 2)
End With
'set the destination range using the last column variable
'in this case from B3 to the last column
With ThisWorkbook.Sheets("ExpReceipts")
Set RngTarget = .Range(.Cells(1, 3), .Cells(1, lastcol))
End With
'then execute the copy
RngSource.Copy RngTarget
This is the same idea as Setup for column population of a formula below, but horizontal in a row instead of vertically in a column.
Vertical FIND (works fast, declare which column to search vertically in)
WhatImLookingFor = "whatever you're looking for...."
With Sheets("Sheet1").Range("B:B")
Set FndRng = .Find(What:=WhatImLookingFor, LookIn:=xlValues, LookAt:=xlWhole)
If Not FndRng Is Nothing Then ' <-- Find was successful
toprow = FndRng.Row
and do other stuff if found
Else
do something else
End If
End With
Auto Calculating
Application.Calculation = xlManual
Application.Calculation = xlAutomatic
Summing in a defined range by exploiting the worksheet's built-in Sum function
Sheets().range().value = WorksheetFunction.Sum(thisrange) ...(just define thisrange)
Messin' around with opening other files
Let's open two files.
Open Book1 as read-only. Open Book2 to edit
Close Book1 without saving, close Book2 and save.
For Book2, I'm writing the date/time in A1 as an edit.
The full Workbooks path must be declared as files open and change focus
I'm also turning off alerts to avoid the Microsoft warning:
Be careful! Parts of your document may include personal information
that can't be removed by the Document Inspector.
Sub button_LOAD_Click()
'Open source and destination files
'Avoid warning for document may include personal info
'turn Alerts off
Application.DisplayAlerts = False
'My workbook
MyWorkbook = ActiveWorkbook.Name
'Source workbook
SourceFilePATH = Workbooks(MyWorkbook).Sheets("ControlPanel").Range("D4").Value
SourceFileNAME = Workbooks(MyWorkbook).Sheets("ControlPanel").Range("D5").Value
Set Sourcebook = Workbooks.Open(Filename:=SourceFilePATH & SourceFileNAME, ReadOnly:=True)
'Destination workbook
DestFilePATH = Workbooks(MyWorkbook).Sheets("ControlPanel").Range("D7").Value
DestFileNAME = Workbooks(MyWorkbook).Sheets("ControlPanel").Range("D8").Value
Set Destbook = Workbooks.Open(Filename:=DestFilePATH & DestFileNAME, ReadOnly:=False)
'change something in the dest workbook
Workbooks(DestFileNAME).Sheets("Sheet1").Range("A1").Value = Now()
'switch back to prime workbook
Workbooks(MyWorkbook).Activate
'close other Workbooks when done, save dest, don't save source
Workbooks(SourceFileNAME).Close savechanges:=False
Workbooks(DestFileNAME).Close savechanges:=True
End Sub
Range copy - Full format
Workbooks("SomeWorkbook").Sheets("Sheet1").Range("A1:Z" & lastrow).Copy Destination:=Sheets("MySheet").Range("A1")
You can also pick one cell and and grab the CurrentRegion to copy
(the local contiguously populated cells), and let Excel figure out the copy range.
Workbooks("SomeWorkbook").Sheets("Sheet1").Range("A1").CurrentRegion.Copy Destination:=Sheets("MySheet").Range("A1")
Centering columns (as many as you want)
Sheets("MySheet").Range("B:B,D:D,F:F,H:H,J:J,L:L,N:N,P:P").HorizontalAlignment = xlCenter
'or xlLeft xlRight
Setting borders, cell colors on another sheet
You can't Select on another sheet: Sheets("AnotherSheet").Range("xx").Select. But you can draw focus on that sheet using the With command and conduct your changes by declaring the object attributes. Here's (1) a clear of contents, (2) no color fill, and (3) no borders in a range on another sheet without switching to that sheet to Activesheet.Select:
With Sheets("AnotherSheet")
.Range("A2:Z90000").ClearContents
.Range("A2:Z90000").Borders.LineStyle = xlNone
.Range("A2:Z90000").Interior.Pattern = xlNone
.Range("A2:Z90000").Interior.TintAndShade = 0
.Range("A2:Z90000").Interior.PatternTintAndShade = 0
End With
Advanced Filtering - the fastest data row extractor ever
Remember that the template range must be in the same format as the columns you need.
I use three Range variables:
Dim rgData As Range, rgCriteria As Range, rgOutput As Range
I like to keep these four lines of code together to set the Ranges and launch the AdvFilter:
Set rgData = ThisWorkbook.Worksheets("SourceSheet").Range("A1").CurrentRegion
Set rgCriteria = ThisWorkbook.Worksheets("TemplateSheet").Range("B1:I2")
Set rgOutput = ThisWorkbook.Worksheets("DestinationSheet").Range("B5")
rgData.AdvancedFilter xlFilterCopy, rgCriteria, rgOutput
SORT: Exploiting the Macro Recorder for sorting
Sorting is easy and fast but don't waste a lot of time debugging a sort routine. Just record a live sort Macro of your sheet. Then find the last row programmatically and replace the last row number in that recorded Macro code with your own lastrow variable to make the sort dynamic.
'Find the last row first
With Sheets("Sheet1")
lastrow = .Range("B" & .Rows.Count).End(xlUp).Row
End With
Then sort - replace the last row number with your lastrow variable (in red below). In this example I'm sorting columns A,B,C on column C. This is the recorded Macro code with my lastrow substituted in.
Sheets("Sheet1").Sort.SortFields.Clear
Sheets("Sheet1").Sort.SortFields.Add Key:=Range( _
"C2:C" & lastrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With Sheets("Sheet1").Sort
.SetRange Range("A2:C" & lastrow)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
PIVOT: Again, exploiting the Macro Recorder for sorting
You can also exploit the Macro recorder in the same manner to programmatically create Pivot Tables. But after recording, consider that you are recording the build of a pivot table on the current sheet, so you're going to return several statements with "Activesheet" in them. You'll want to scrub out those Activesheet declarations. You may also want to formulate the source and destination ranges with variables and replace the hard-coded ranges in the Pivot-building code.
With Sheets("Shipments")
lastSHIPPEDrow = .Range("B" & .Rows.Count).End(xlUp).Row - 1
End With
thisrange = "Scratch!$J$1:$K$" & lastSHIPPEDrow 'using a dynamic "lastrow" again
Sheets("Scratch").Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
thisrange, Version:=6).CreatePivotTable TableDestination:= _
"Scratch!R1C13", TableName:="PivotTable3", DefaultVersion:=6
With ActiveSheet.PivotTables("PivotTable3").PivotFields("CO Line")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _
"PivotTable3").PivotFields("QTY Shipped"), "Sum of QTY Shipped", xlSum
Making some range all white (with white gridlines)
Sheets("Sheet1").Range("A1:Z500").Borders.Color = vbWhite
Sheets("Sheet1").Range("A1:Z500").Borders.LineStyle = xlContinuous
Sheets("Sheet1").Range("A1:Z500").Interior.Color = vbWhite
Setup for column population of a formula
I do this constantly. Basically I want to populate a formula in the top row of a column, then copy that formula down to the bottom row. Some givens: (a) I need to know what the bottom row of the sheet is and (b) as I mentioned, I don't like to leave formulas in cells - I'll PasteValues at the end.
I don't like to write formulas directly into cells. I'll write them to a variable, like "thisformula". Then write the variable to the top cell. Here's an example...
Let's write a simple formula, copy it down, then replace the formulas with values
'First, what's the bottom row?
With Sheets("Sheet1")
lastrow = .Range("A" & .Rows.Count).END(xlUp).Row
End With
'OK now some formula - if the value of P2 is zero, then use Q2, otherwise use P2
thisformula = "=if(P2=0,Q2,P2)"
'write the formula in row 2 of column R
Sheets("Sheet1").Range("R2").Formula = thisformula
'now you know the bottom row so copy the formula down the whole column
Sheets("Sheet1").Range("R2").Copy Destination:=Sheets("Sheet1").Range("R3:R" & lastrow)
'Great, now copy the whole column and PasteValues in place in the same column R
Sheets("Sheet1").Range("R2:R" & lastrow).Copy
With Sheets("Sheet1")
.Range("R2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
Application.CutCopyMode = False
Formulas with quotes in them
If your formula needs quotes, don't forget to double-up quotes in the variable declaration
Here's a date parsing to MM/DD/YYYY that needs "/" in the formula:
thisformula = "=concatenate(mid(P2,4,2),""/"",mid(P2,6,2),""/20"",mid(P2,2,2))"
Formulas with Dynamic Ranges
VLOOKUP is a good example. You need to VLOOKUP from a source range into your sheet column. This time you need to know the bottom row of your sheet AND the bottom row of your VLOOKUP source data.
'the bottom of your sheet column
With Sheets("Sheet1")
lastrow = .Range("A" & .Rows.Count).END(xlUp).Row
End With
'the bottom of your source dataWith Sheets("SourceData")
lastSOURCErow = .Range("D" & .Rows.Count).END(xlUp).Row
End With
'Now your VLOOKUP dynamic formula might look like this (I have double quotes on the IFERROR for "")
thisformula = "=IFERROR(VLOOKUP(D2,SourceData!$A$2:$F$" & lastSOURCErow & ",6,FALSE),"""")"
'Then follow the same copy-down procedure as above with lastrow
Setting Up Buttons to Click On
For button controls, I usually choose ActiveX objects. Here is my procedure for adding buttons. First, I switch the sheet to Design mode and add an ActiveX Command Button from the Insert menu.
Before doing anything else, I like to set some rough properties. Right-click the button then select Properties. I immediately give the button a Name and a Caption. The Name is for VBA code, the Caption is what the users see. Then, considering that I usually have more than one button, I take note of the Height and Width of the button, and how far from the Left and the Top of the screen. These are values I work with to make sure the buttons are all the same size. I also use the Height / Width values to determine spacing when stacking buttons in a vertical column or laying them out in a horizontal row
Once the button has a Name and a Caption, I right-click the button again and View Code. As soon as that's done the first time, Excel will insert a new Sub for the Click event on that button name. That's why it's important to name the button first. Once the Sub is active, I can start writing code.
Cleaning Up Button Layouts
Sometimes when running VBA code for users that changes justifications, row widths, and column heights, the layout, size, and font size of buttons can be misaligned. At the end of routines or in any cleanup process, I like to quickly run through the button layout and reorient some of the properties. I do that with a quick Fix_Buttons() subroutine that I call from my Sub as the last action. In the case of the CLR and LOAD button examples above, my
Fix_Buttons() sub might look like this:
Sub Fix_Buttons()
'CLR Click
button_CLR.AutoSize = False
button_CLR.Height = 25
button_CLR.Width = 50
button_CLR.Font.Size = 12
button_CLR.Top = 89
button_CLR.Left = 15
'LOAD Click
button_LOAD.AutoSize = False
button_LOAD.Height = 25
button_LOAD.Width = 50
button_LOAD.Font.Size = 12
button_LOAD.Top = 126
button_LOAD.Left = 15
End Sub
Copy... Paste VALUES
This is a little different from (Range.Copy Destination :=Range). First I copy, then I paste values, then I turn off CutCopyMode.
'Point to Range and Copy
Sheets("MySheet").Range("An:Z" & lastrow).Copy ...or Range ("A1").CurrentRegion.Copy
'Then point to destination range top-left corner, and paste
Sheets("MySheet").Range("X1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks :=False, Transpose:=False
'Then turn off CutCopyMode Application.CutCopyMode = False
Copy... Paste VALUES (horizontal with column index numbers)
'again the last column
lastcol = Sheets("ExpReceipts").Cells(3, Columns.Count).End(xlToLeft).Column
'setup the target range
With ThisWorkbook.Sheets("ExpReceipts")
Set RngTarget = .Range(.Cells(1, 3), .Cells(1, lastcol))
End With
'copy, paste special, and turn off CutCopyMode
RngTarget.Copy
RngTarget.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Application.CutCopyMode = False
Copy... Paste TRANSPOSE
Same as Copy... Paste VALUES above, but with different Paste options. don't forget to turn off CutCopyMode.
Sheets("MySheet").Range("X1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:= False, Transpose:=True