Search

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...):
    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)
    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 data
With 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