Excel VBA Loops

NEW! More Books..

Add Excel Answers & Search To Your Google Toolbar Details

Correct/Efficient Uses of Excel Loops

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!

See Also: Excel VBA Loops Explained. Back to: Excel VBA . 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
		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!

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
rAcells.Select
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"
       End
    ElseIf rCcells Is Nothing Then
       Set rAcells = rFcells 'formulas
    ElseIf rFcells Is Nothing Then
       Set rAcells = rCcells 'constants
    Else
       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, _
             MatchCase:=True)
      rNa.Font.Bold=True       
    
 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.", _
  Title:="CONCATENATION OF CELLS", Type:=8)
  
 If rCells Is Nothing Then 'Cancelled or mistake
    iReply = MsgBox("Invalid selection!", _
             vbQuestion + vbRetryCancel)
     If iReply = vbCancel Then
        On Error GoTo 0
        Exit Sub
     Else
        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

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!

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