EXCEL VIDEO TUTORIALS / EXCEL DASHBOARD REPORTS

Ozgrid, Experts in Microsoft Excel Spreadsheets

Excel VBA Loops

 

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 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 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 special@ozgrid.com 31 days after purchase date.


Instant Download and Money Back Guarantee on Most Software

EXCEL VIDEO TUTORIALS / 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

Some of our more popular products are below...
Convert Excel Spreadsheets To Webpages | Trading In Excel | Construction Estimators | Finance Templates & Add-ins Bundle | Code-VBA | Smart-VBA | Print-VBA | Excel Data Manipulation & Analysis | Convert MS Office Applications To...... | Analyzer Excel | Downloader Excel | MSSQL Migration Toolkit | Monte Carlo Add-in | Excel Costing Templates