Excel VBA Loops

< Back to Search results

 Category: [Excel]  Demo Available 

Excel VBA Loops


Correct/Efficient Uses of Excel Loops

Got any Excel/VBA Questions? Free Excel Help

Don't get caught in the Loop:

To put it bluntly I very often avoid Loops, they are far too slow in many cases. 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 within a used range, i.e it assumes the last occupied cell is D500

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()

    If WorksheetFunction.CountA(Range("A1:D500")) = 0 Then

       MsgBox "All cells are empty", vbOKOnly, "OzGrid.com"

       Exit Sub

    End If

    On Error Resume Next

    Range("A1:D500").SpecialCells(xlCellTypeBlanks) = "Blank"

    On Error GoTo 0

End Sub

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 favourites 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. You just need to step outside the box! 

Here is another comparison to stress my point!:
Place the text "Find Me" into cell IV65536 and run this code: 

Sub NoLoop()

    If WorksheetFunction.CountIf(Cells, "Find Me") = 0 Then

       MsgBox "You didn't type 'Find Me'", vbOKOnly, "OzGrid.com"

       Exit Sub

    End If


	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 that uses a Loop:

Sub WithLoop()

Dim rCell As Range

   For Each rCell In Cells

	If rCell.Value = "Find Me" Then


		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! 

Now sometimes a Loop might be the only way or the best way (not too often though). If this is the case we should restrict our range to only the cells we need. The example below will change the font color of all negative value cells to yellow and the background to red for an entire Worksheet. Truth be known I would use conditional formatting! Before it performs the loop though it restricts the range to only numeric cells. 

Sub FastestLoop()

Dim rCcells As Range, rFcells As Range

Dim rAcells As Range, rLoopCells As Range

'Set variable to all used cells

Set rAcells = ActiveSheet.UsedRange


On Error Resume Next 'In case of no formula or constants.

'Set variable to all numeric constants

Set rCcells = rAcells.SpecialCells(xlCellTypeConstants, xlNumbers)

'Set variable to all numeric formulas

Set rFcells = rAcells.SpecialCells(xlCellTypeFormulas, xlNumbers)

    'Determine which type of numeric data (formulas, constants or none)

    If rCcells Is Nothing And rFcells Is Nothing Then

       MsgBox "You Worksheet contains no numbers"


    ElseIf rCcells Is Nothing Then

       Set rAcells = rFcells 'formulas

    ElseIf rFcells Is Nothing Then

       Set rAcells = rCcells 'constants


       Set rAcells = Application.Union(rFcells, rCcells) 'Both

    End If

    On Error GoTo 0

    'Loop through needed cells only see if negative

    For Each rLoopCells In rAcells

        If rLoopCells.Value < 0 Then

            With rLoopCells

               .Interior.ColorIndex = 6

               .Font.ColorIndex = 3

            End With

       End If

    Next rLoopCells

End Sub

Here is another way to speed up a loop that makes use of Excel's COUNTIF function. The code could be modified to suit almost any situation very easily. This particular Procedure Bolds all instances of the "Cat" in Column "A" of the active sheet.

Sub BoldCat()

Dim iLoop As Integer

Dim rNa As Range

Dim i As Integer

iLoop = WorksheetFunction.CountIf(Columns(1), "Cat")

Set rNa = Range("A1")

 For i = 1 To iLoop

  Set rNa = Columns(1).Find(What:="Cat", After:=rNa, _

             LookIn:=xlValues, LookAt:=xlWhole, _

             SearchOrder:=xlByRows, SearchDirection:=xlNext, _




 Next i

End Sub

What Loops Are Good For

The examples below here show what loops are good for, in this case it is looping through a text string and passing back the positions of / within the string to an array. The array (in this case) would result in {6,11,19,22}. Each number representing the position of each /

Sub GetIt()

Dim i As Integer

Dim strText As String

Dim iPositions() As Integer

Dim iStart As Integer

Dim iLoop As Integer

strText = "Ihave/four/OfThese/In/Me"

'Find out how many "/" are within the string by subtracting _

 Len("Ihave/four/OfThese/In/Me") from Len("IhavefourOfTheseInMe") _

 This will result in four. We then take 1 because the first element _

 in an Array is always zero, unless told otherwise.

iLoop = Len(strText) - Len _

        (Application.Substitute(strText, "/", "")) - 1

'Tell the array how many elements it is to hold.

ReDim iPositions(iLoop) As Integer

iStart = 1

    For i = 0 To iLoop 'loop four times

        'Parse the position of the nth "/" Starting from iStart .

        iPositions(i) = InStr(iStart , strText, "/")

        'Add one to the found position, for next InStr to Start from.

        iStart = iPositions(i) + 1

        MsgBox "Number " & i + 1 & " '/' is in position " & _

        iPositions(i), vbInformation, "OzGrid.com"

    Next i

End Sub

Hide All But One Sheet

Loop through all sheets in a Workbook and hide all but Sheet1. Excel will not allow all sheets hidden.

Sub HideAllButOneSheet()

'We must leave at least one Sheet visible

Dim wsSheet As Worksheet

    For Each wsSheet In Worksheets

       wsSheet.Visible = wsSheet.Name = "Sheet1"

    Next wsSheet

End Sub

Show All Sheets

Loop through all sheets in a Workbook and Show all Sheets.

Sub ShowAllSheets()

Dim wsSheet As Worksheet

    For Each wsSheet In Worksheets

       wsSheet.Visible = True

    Next wsSheet

End Sub

Toggle Sheet Visibility

Loop through all sheets in a Workbook and toggle the visibility

Sub ToogleSheetVisiblity()

'You must leave at least one Sheet visible

Dim wsSheet As Worksheet

On Error Resume Next 'If code tries to hide all Sheets

    For Each wsSheet In Worksheets

       wsSheet.Visible = Not wsSheet.Visible

    Next wsSheet

On Error GoTo 0 'One sheet will always be left visible

End Sub

Unprotect All Sheets

Loop through all sheets in a Workbook and Unprotect them. To protect simply replace Unprotect with Protect

Sub ProtectAllSheets()

Dim wsSheet As Worksheet

On Error Resume Next

    For Each wsSheet In Worksheets

       wsSheet.Unprotect Password:="SecretWord"

    Next wsSheet

On Error GoTo 0

End Sub

Join the text of multiple cells

This code will display an InputBox that allows the user to select specific cells that will all be joined (Concatenated) in the first cell selected.

Sub JoinCells()

Dim rCells As Range

Dim rRange As Range

Dim rStart As Range

Dim strStart As String

Dim iReply As Integer

On Error Resume Next


'Allow user to nominate cells to join

Set rCells = Application.InputBox _

  (Prompt:="Select the cells to join," _

  & "use Ctrl for non-contiguous cells.", _



 If rCells Is Nothing Then 'Cancelled or mistake

    iReply = MsgBox("Invalid selection!", _

             vbQuestion + vbRetryCancel)

     If iReply = vbCancel Then

        On Error GoTo 0

        Exit Sub


        Run "JoinCells" 'Try again

     End If

  End If


 'Set range variable to first cell

 Set rStart = rCells(1, 1)


 'Loop through cells chosen

 For Each rRange In rCells

    strStart = rRange 'parse cell content to a String

    rRange.Clear 'Clear contents of cell

    'Replace the original contents of first cell with "", then _

     join the text

    rStart = Trim(Replace(rStart , rStart , "") & " " _

                  & rStart & " " & strStart )

 Next rRange

  On Error GoTo 0


End Sub


See also:

Index to Excel VBA Code
Worksheet Names Stored In Cells For Excel Formula References
Prevent Excel VBA Macro Code Being Case Sensitive
Excel: Delete/Deleting Blank Rows With Excel VBA
Excel VBA Events
Excel VBA Intersect Method


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.


stars (0 Reviews)