Excel VBA Loops
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 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
See also:
| Index to Excel VBA Code |
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.