<<Convert Excel Spreadsheets to Web Pages \| Trading Software That Operates Within Excel \| Convert Excel, Access & Other Databases \| Merge Excel Files>>

Excel VBA Loops

| | Information Helpful? Why Not Donate.

TRY OUT: Smart-VBA | Code-VBA | Analyzer-XL | Downloader-XL | Trader-XL| More Free Downloads.. Best Value: Finance Templates Bundle

Correct/Efficient Uses of Excel Loops

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 BcellEnd 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 0End 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 rCellEnd 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 RangeDim rAcells As Range, rLoopCells As Range'Set variable to all used cellsSet rAcells = ActiveSheet.UsedRangerAcells.SelectOn Error Resume Next 'In case of no formula or constants.'Set variable to all numeric constantsSet rCcells = rAcells.SpecialCells(xlCellTypeConstants, xlNumbers)'Set variable to all numeric formulasSet 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 rLoopCellsEnd Sub

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

Sub BoldCat()Dim iLoop As IntegerDim rNa As RangeDim i As IntegeriLoop = 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 iEnd 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 stringand 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 IntegerDim strText As StringDim iPositions() As IntegerDim iStart As IntegerDim iLoop As IntegerstrText = "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 IntegeriStart = 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 iEnd 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 visibleDim wsSheet As Worksheet    For Each wsSheet In Worksheets       wsSheet.Visible = wsSheet.Name = "Sheet1"    Next wsSheetEnd 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 wsSheetEnd Sub

Toggle Sheet Visibility

Loop through all sheets in a Workbook and toggle the visibility

Sub ToogleSheetVisiblity()'You must leave at least one Sheet visibleDim wsSheet As WorksheetOn Error Resume Next 'If code tries to hide all Sheets    For Each wsSheet In Worksheets       wsSheet.Visible = Not wsSheet.Visible    Next wsSheetOn Error GoTo 0 'One sheet will always be left visibleEnd 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 WorksheetOn Error Resume Next    For Each wsSheet In Worksheets       wsSheet.Unprotect Password:="SecretWord"    Next wsSheetOn Error GoTo 0End 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 RangeDim rRange As RangeDim rStart As RangeDim strStart As StringDim iReply As IntegerOn Error Resume Next 'Allow user to nominate cells to joinSet 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 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. ALLpurchases 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

Try out:Analyzer XL |Downloader XL |Smart VBA |Trader XL Pro (best value) |ConsoXL | MergeXL | O2OLAP for Excel | MORE>>

Excel Trader PackageTechnical 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