Excel VBA Macro Codes Tips & Tricks
Got any Excel/VBA Questions? Free Excel Help
Stop text case sensitivity:
Option compare Text ' "A" is equal to "a". Sub MyMacro 'Your code here. End Sub
Make text case sensitive (Excels default)
Option compare Binary ' "A" is NOT equal to "a". Sub MyMacro 'Your code here. End Sub
Use Sheet Code names:
These can be seen in the "Project Explorer" (Ctr+R). Get into this habit as the Code name never changes, even if the sheet is renamed or moved within the workbook.
Use ThisWorkbook:
E.g. ThisWorkbook.Name This will always return the name of the workbook that is hosting the code. *Do not use ThisWorkbook with Add-Ins. Use ActiveWorkbook..
InputBox that returns a Range:
Sub Demo() Dim MyRange As Range Set MyRange = Application.InputBox _ (Prompt:="Select any range", Title:="Demo", Type:=8) MyRange.Select End Sub
Using the Inputbox to create a unique list from Column A:
Sub UniqueList()
Dim rListPaste As Range
Dim iReply As Integer
On Error Resume Next
Set rListPaste = Application.InputBox _
(Prompt:="Please select the destination cell", Type:=8)
If rListPaste Is Nothing Then
iReply = MsgBox("No range nominated," _
" terminate", vbYesNo + vbQuestion)
If iReply = vbYes Then Exit Sub
End If
Range("A1", Range("A65536").End(xlUp)).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=rListPaste.Cells(1, 1), Unique:=True
End Sub
Use the Keyword Me:
When coding with the Workbook events use the keyword Me.
Private Sub Workbook_Open() MsgBox Me.FullName End Sub
When coding with the Worksheet events use the keyword Me.
Private Sub Worksheet_Activate() MsgBox Me.CodeName End Sub
When coding with a UserForm use the keyword Me.
Private Sub UserForm_Activate() MsgBox Me.Name End Sub
Stop a user from closing a UserForm via the X:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = 0 Then Cancel = True MsgBox "Please use the Cancel button", vbCritical End If End Sub
Create a Template of your UserForm Controls:
When working with UserForm Controls you often find that you need an "OK" and "Cancel" Button, and other Controls that you want to keep uniformed with other UserForms. You can create a Template of your Controls on the Toolbox!
1. Right click on the Control Toolbox page tab name
2. Select New Page
3. Right click on the new page name tab and select Rename.
4. Type the name "Templates" and click OK
5. Using the Control page, place your common Controls on a UserForm
6. Type in captions, size them and alter other Properties.
7. Activate your Template page and drag your Controls onto it.
Now simply use these next time you create a UserForm.
CommandButton from Control Toolbox on a Worksheet Problem:
A common problem with these is that they will take Focus when clicked, which can then causes very hard to track errors within your code. Prevent this by either setting the "TakeFocusOnClick" Propery to False in the Property Window of the CommandButton or shift focus back to the Worksheet, as shown below:
Private Sub CommandButton1_Click() [A1].Select 'Your code here. End Sub
Making sure the Combobox selection is part of the list:
Private Sub ComboBox1_Change() If ComboBox1.ListIndex >= 0 Then 'Your code here End If End Sub
Prevent endless loops within events:
Private Sub Worksheet_Change(ByVal Target As Excel.Range) On Error GoTo ResetEvents Application.EnableEvents = False 'Your code here. Application.EnableEvents = True Exit Sub ResetEvents: Application.EnableEvents = True End Sub
*Note the use of "On Error GoTo ResetEvents"
This is so if an unexpected error occurs the EnableEvents will still be set back to True.
Don't get caught in the Loop:
To put it bluntly I avoid Loops like the plague, they are far too sloooow! A common mistake we all make when first learning VBA is to use Loops when we really shouldn't..Take the simple example below for instance. It Loops through a range and places the word "Blank" in each blank cell.
Sub WrongWay()
Dim Bcell As Range
For Each Bcell In Range("A1:D500")
If IsEmpty(Bcell) Then Bcell = "Blank"
Next Bcell
End Sub
Now compare the above code to this one:
Sub RightWay()
Range("A1:D500").SpecialCells(xlCellTypeBlanks) = "Blank"
End Sub
Not only is it much easier to type but it will run much much quicker.
Next time you have a VBA task, don't rush in with a Loop. Step back and give some serious thought to Excels built in functions. Some of my favorites to use are: SpecialCells, AutoFilter, Find, AdvancedFilter andSubtotals to name but a few. Once you Start to make use of these you will always think twice before using a Loop of any kind.
Instead of a Loop, try inserting a Column and placing a formula in the required range that makes the check on the cells. Use a number for a Yes and text for a No, then use SpecialCells to do the rest. I can promise you there is nearly always a built in feature that will execute at least 100 times quicker than a Loop. Just step outside the box!
Here is another comparison to stress my point!:
Place the text "Find Me" into cell IV65336 and run this code:
Sub NoLoop() Cells.Find(What:="Find Me", After:=[A1], LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False).Activate End Sub
Now if you have at least 5 minutes to spare, try this code:
Sub WithLoop() Dim rCell As Range For Each rCell In Cells If rCell.Value = "Find Me" Then rCell.Activate Exit For End If Next rCell End Sub
To stop the Loop, push Ctrl+Break or Esc. Now that has to at least make you try alternatives for Loops!
Is the cell within a range ?:
At times you may need to know whether a particular cell is within another range. One of the most common reason would be when dealing with the Change event. To achieve this we can use Intersect, which is a member of the Application Object.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Reset Events if an unexpected error occurs.
On Error GoTo ResetEvents
'More than one cell selected, so do nothing
If Target.Cells.Count > 1 Then Exit Sub
'If intersect does not return nothing, _
changed cell is within A1:A10.
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
'Prevent an endless loop
Application.EnableEvents = False
MsgBox Target.Address
Application.EnableEvents = True
End If
Exit Sub
ResetEvents:
Application.EnableEvents = True
End Sub
Use the Macro recorder:
Use the macro recorder often, this will eliminate typos. I often use this, especially if I need a Workbooks full path name, so that I can open it via VBA. It is also a very handy tool when working with Pivot Tables, Charts etc. Once you have your recorded code, go though it and modify it to speed things up. Two common words you can usually remove are "Select" and "Selection".
While the Macro recorder is a great tool for learning VBA (when used correctly) and making coding easier, it is horribly inefficient in writing code. You must remember that the Recorder ONLY records your steps taken in the Interface, it doesn't write the VBA code that SHOULD be used to achieve these steps.
Letting Excel write cell formula code for you:
If you need to write some code that will place a formula (simple or complicated) in a range, don't try to write it yourself in the VBE. Type the formula in a cell then with the cell still active record a Macro, push F2 (edit cell) then push Enter. Now stop recording and your code will be written for you.
Lower case all code:
When typing your code try and get into the habit of using lower case only. This way if you have typed the code correctly, the VBE will capitalize the correct letters for you. If they dont capitilize then check you code for spelling errors.
Stop users from scrolling about:
Here's a very simple line of code that will stop users from scrolling about a chosen worksheet. To place the code in, right click on the sheet name tab, select "View Code" and paste in this code.
Private Sub Worksheet_Activate() Me.ScrollArea = "A1:L20" 'To set back to normal use: Me.ScrollArea = "" End Sub
Now whenever the user activates the sheet they will be restricted to the range A1:L20.
Print a long Column of data:
Here's a handy little bit of code if you have a long list of data in 1 Column ("A" in this case). It will automatically move the range of data at each horizontal page break to adjacent columns.
I have also made this available for download here.
Sub RowsToColumns() Dim rCol As Range Dim rCell1 As Range, rCell2 As Range Dim i As Integer, iPBcount As Integer Dim Sht As Worksheet Application.StatusBar = "Converting, please wait....!" Application.ScreenUpdating = False 'Set range variable to Selection Set Sht = ActiveSheet Set rCol = Sht.UsedRange.Columns(1) 'Insert page breaks Sht.PageSetup.PrintArea = "" Sht.PageSetup.Zoom = 100 ActiveWindow.View = xlPageBreakPreview 'Count only horizontal page breaks and pass to an Integer iPBcount = Sht.HPageBreaks.Count On Error Resume Next 'Loop as many times as there horizontal page breaks. For i = 1 To iPBcount 'Set variable 1 to page break X Set rCell1 = Sht.HPageBreaks(i).Location 'Set variable 2 to X page break Set rCell2 = Sht.HPageBreaks(i + 1).Location.Offset(-1, 0) If rCell2 Is Nothing Then 'Last page break Range(rCell1, rCol.Cells(65536, 1).End(xlUp)).Cut _ Destination:=Sht.Cells(1, i + 1) Else Range(rCell1, rCell2).Cut Destination:=Sht.Cells(1, i + 1) End If Set rCell1 = Nothing Set rCell2 = Nothing Next i On Error GoTo 0 ActiveWindow.View = xlNormalView Application.ScreenUpdating = True Sht.DisplayPageBreaks = False Application.Goto rCol.Cells(1, 1), True Set rCol = Nothing Application.StatusBar = "" End Sub
Collect an array of numbers and enter them:
This Procedure will display an Input box that asks the user to enter numbers below 100 seperated by a commas and/or a dash. It then enters the numbers into a range (Column A in this case).
Sub ParseNumbers()
Dim sIn As String
Dim iCount As Integer
''''''''''''''''''''''''''''''
'Enters an array of numbers into a range.
'Written by OzGrid.com
'''''''''''''''''''''''''''''''
'Trim removes excess spaces(not single spaces between text)
sIn = InputBox("Enter Numbers below 100 seperated by" _
& "a comma or dash eg 1,14-16,2,22", "OzGrid Business Applications")
If sIn = "" Then Exit Sub 'They canceled
With WorksheetFunction
'Remove the comma.
sIn = Trim(.Substitute(sIn, ",", " "))
'Remove the dash.
sIn = Trim(.Substitute(sIn, "-", " "))
'Count the characters after removing spaces.
iCount = Len(.Substitute(sIn, " ", ""))
'Loop as many times as there are characters
For i = 1 To iCount
'Extract first 2 numbers, Trim will remove _
trailing or leading spaces.
Cells(i, 1) = Trim(Mid(sIn, 1, 2))
'Replace the number extracted with empty text
sIn = Trim(.Substitute(sIn, Cells(i, 1), " ", 1))
If sIn = "" Then Exit For 'No more numbers
Next i
End With
End Sub
Convert all formulas to absolute/relative:
This method allows us to change a range of formulas from Absolute to Relative, Relative to Absolute, Relative Row to Absolute Row and so on... In fact we can change any relative or absolute aspect of any formula.
Sub MakeAbsoluteOrRelative()
'Written for www.ozgrid.com
'By Andy Pope
'www.andypope.info/
Dim RdoRange As Range, rCell As Range
Dim i As Integer
Dim Reply As String
'Ask whether Relative or Absolute
Reply = InputBox("Change formulas to?" & Chr(13) & Chr(13) _
& "Relative row/Absolute column = 1" & Chr(13) _
& "Absolute row/Relative column = 2" & Chr(13) _
& "Absolute all = 3" & Chr(13) _
& "Relative all = 4", "OzGrid Business Applications")
'They cancelled
If Reply = "" Then Exit Sub
On Error Resume Next
'Set Range variable to formula cells only
Set RdoRange = Selection.SpecialCells(Type:=xlFormulas)
'determine the change type
Select Case Reply
Case 1 'Relative row/Absolute column
For Each rCell In RdoRange
If rCell.HasArray Then
If Len(rCell.FormulaArray) < 255 Then
rCell.FormulaArray = _
Application.ConvertFormula _
(Formula:=rCell.FormulaArray, _
FromReferenceStyle:=xlA1, _
ToReferenceStyle:=xlA1, ToAbsolute:=xlRelRowAbsColumn)
End If
Else
If Len(rCell.Formula) < 255 Then
rCell.Formula = _
Application.ConvertFormula _
(Formula:=rCell.Formula, _
FromReferenceStyle:=xlA1, _
ToReferenceStyle:=xlA1, ToAbsolute:=xlRelRowAbsColumn)
End If
End If
Next rCell
Case 2 'Absolute row/Relative column
For Each rCell In RdoRange
If rCell.HasArray Then
If Len(rCell.FormulaArray) < 255 Then
rCell.FormulaArray = _
Application.ConvertFormula _
(Formula:=rCell.FormulaArray, _
FromReferenceStyle:=xlA1, _
ToReferenceStyle:=xlA1, ToAbsolute:=xlAbsRowRelColumn)
End If
Else
If Len(rCell.Formula) < 255 Then
rCell.Formula = _
Application.ConvertFormula _
(Formula:=rCell.Formula, _
FromReferenceStyle:=xlA1, _
ToReferenceStyle:=xlA1, ToAbsolute:=xlAbsRowRelColumn)
End If
End If
Next rCell
Case 3 'Absolute all
For Each rCell In RdoRange
If rCell.HasArray Then
If Len(rCell.FormulaArray) < 255 Then
rCell.FormulaArray = _
Application.ConvertFormula _
(Formula:=rCell.FormulaArray, _
FromReferenceStyle:=xlA1, _
ToReferenceStyle:=xlA1, ToAbsolute:=xlAbsolute)
End If
Else
If Len(rCell.Formula) < 255 Then
rCell.Formula = _
Application.ConvertFormula _
(Formula:=rCell.Formula, _
FromReferenceStyle:=xlA1, _
ToReferenceStyle:=xlA1, ToAbsolute:=xlAbsolute)
End If
End If
Next rCell
Case 4 'Relative all
For Each rCell In RdoRange
If rCell.HasArray Then
If Len(rCell.FormulaArray) < 255 Then
rCell.FormulaArray = _
Application.ConvertFormula _
(Formula:=rCell.FormulaArray, _
FromReferenceStyle:=xlA1, _
ToReferenceStyle:=xlA1, ToAbsolute:=xlRelative)
End If
Else
If Len(rCell.Formula) < 255 Then
rCell.Formula = _
Application.ConvertFormula _
(Formula:=rCell.Formula, _
FromReferenceStyle:=xlA1, _
ToReferenceStyle:=xlA1, ToAbsolute:=xlRelative)
End If
End If
Next rCell
Case Else 'Typo
MsgBox "Change type not recognised!", vbCritical, _
"OzGrid Business Applications"
End Select
'Clear memory
Set RdoRange = Nothing
End Sub
Make a Cell Range Flash Different Colors
This Procedure will make the range C3:G13 loop through 5 different colors. The changes occur at 2 second intervals. Note the Dim iCount outside the Procedure, this makes it a Module level variable and thus it keeps its value between calls.
Dim iCount As Integer
Sub ColorChange()
Dim dTime As Date
''''''''''''''''''''''''''''''
'Will make range of cells, or single cell change colors _
at 2 second intervals
'Written by OzGrid.com
'''''''''''''''''''''''''''''''
dTime = Now
Application.OnTime dTime + TimeValue("00:00:02"), "ColorChange"
iCount = iCount + 1
Range("C3:G13").Interior.ColorIndex = Choose(iCount, 3, 36, 50, 7, 34)
If iCount = 5 Then
iCount = 0
Application.OnTime dTime + TimeValue("00:00:02"), "ColorChange", , False
End If
End Sub
See also:
| Index to Excel VBA Code |
See also Index to Excel VBA Code and Index to Excel Freebies and Lesson 1 - Excel Fundamentals and Index to how to… providing a range of solutions.
Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.
Gallery
