Excel VBA Video Training/ EXCEL DASHBOARD REPORTS

Excel VBA Macro Codes Tips & Tricks

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

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. ALL purchases 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

Excel VBA Video Training/ EXCEL DASHBOARD REPORTS

Excel Trader Package Technical 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