FREE Excel STUFF
SearchSearch Excel Content
Excel Help. Popular
NEW! Multiple Excel Search & Links
Excel Formulas
Excel Macros
Excel Newsletter
PRODUCTS
Up to $139.00 FREE!
Categories & SearchSearch for software
Excel Templates
Excel Add-ins
Excel Training
More....
OTHER
Excel Development


Excel VBA Macro Codes Tips & Tricks


NEW! More Books..
Add to Google advanced search! Free Help!

Add Excel Answers & Search To Your Google Toolbar Details

Current Special! Complete Excel Excel Training Course for Excel 97 - Excel 2003, only $145.00. $59.95 Instant Buy/Download, 30 Day Money Back Guarantee & Free Excel Help for LIFE!

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.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 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).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: Excel Duplication Manager Add-in | Excel Number Manager Add-in | Excel Text Manager Add-in | Excel Named Range Add-in Manager | Excel OzGrid Plus Add-in | Excel Time Sheet | Excel Time Wage and Pay book

Excel Dashboard Reports & Excel Dashboard Charts 50% Off

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


Instant Download and Money Back Guarantee on Most Software

Excel Trader Package Technical Analysis in Excel With $139.00 of FREE software!

Add to Google Search Tips FREE Excel Help

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