<<Convert Excel Spreadsheets to Web Pages \| Trading Software That Operates Within Excel \| Convert Excel, Access & Other Databases \| Merge Excel Files>>

Excel VBA Macro Codes Tips & Tricks

| | Information Helpful? Why Not Donate.

TRY OUT: Smart-VBA | Code-VBA | Analyzer-XL | Downloader-XL | Trader-XL| More Free Downloads.. Best Value: Finance Templates Bundle

Back to: Excel VBA . 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.SelectEnd 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:=TrueEnd Sub

Use the Keyword Me:
When coding with the Workbook events use the keyword Me.

Private Sub Workbook_Open()	MsgBox Me.FullNameEnd Sub

When coding with the Worksheet events use the keyword Me.

Private Sub Worksheet_Activate()	MsgBox Me.CodeNameEnd Sub

When coding with a UserForm use the keyword Me.

Private Sub UserForm_Activate()	MsgBox Me.NameEnd 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 IfEnd 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 toFalse 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 IfEnd 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 = TrueExit SubResetEvents:	Application.EnableEvents = TrueEnd 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 BcellEnd 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 and Subtotals 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).ActivateEnd 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 rCellEnd 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 IfExit SubResetEvents:	Application.EnableEvents = TrueEnd 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 dataat 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 StringDim 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 WithEnd 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 IntegerSub 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 IfEnd Sub

Excel Dashboard Reports & Excel Dashboard Charts 50% Off Become an ExcelUser Affiliate & Earn Money

Special! Free Choice of Complete Excel Training Course OR Excel Add-ins Collection on all purchases totaling over $64.00. ALLpurchases totaling over $150.00 gets you BOTH! Purchases MUST be made via this site. Send payment proof to [email protected] 31 days after purchase date.

Instant Download and Money Back Guarantee on Most Software

Try out:Analyzer XL |Downloader XL |Smart VBA |Trader XL Pro (best value) |ConsoXL | MergeXL | O2OLAP for Excel | MORE>>

Excel Trader PackageTechnical Analysis in Excel With $139.00 of FREE software!

Microsoft � and Microsoft Excel � are registered trademarks of Microsoft Corporation. OzGrid is in no way associated with Microsoft