If…Then…ElseIf…Else examples
Select Case examples
For… Next loop examples
Do...Loop examples
Do While ...Loop examples
Do ...Loop While examples
Do Until…Loop examples
Do …Loop Until examples
While...Wend examples

Many times in your work on spreadsheet, you may want to repeat an action (populate a formula, copy value over to somewhere, formatting, etc) a predetermined number of times, or to repeat an action or a series of action base upon a variable value that changes every time, or repeat until a certain condition is met. Under such circumstances, you would use loops structures  or conditional statement in VBA. Of course, there is nothing wrong if a readily recorded macro can do all the jobs for you, but a variable code should give you much more flexibility and advantages over hard-coding the number of repetitions. For example, when the sheet that you received sometimes had certain columns changed or the header names had changed, you would find that your recorded macro no longer work. Worst the macro may still worked and gave you the output that seemed normal but you did not notice that it had computed the wrong columns and what you thought normal was in deed a very misleading result.

The syntax for If…Then…Else statement is: 

If condition Then
    statements1
Else
    statements2
End If

You can use any number of ElseIf lines in a block IF statement, each with its own condition. It all depends on how complex the conditions and your problem are that you need to evaluate. Although the Else clause is optional, but because there is still a possibility that none of the stated conditions is true, you want to make it catches all conditions by providing with a last Else clause. The last Else in your list of conditions would act if none of the primary conditions is true. Take note that a single line If…Then…ElseIf…Else statements don’t need and End If statement, but a block If…Then…ElseIf…Else statements do need an End If. The syntax for If…Then…ElseIf…Else statement is:

Select Case Expression
   Case Expression1
      statement1
   Case Expression2
      statement2
   Case Expression3
      statement3
   Case Else
      statement4
End Select

There are five types of Indefinite-iteration loop of using While or Until:
Do While…Loop :Continue to perform a statement or a sequence of actions if a condition is True, and stops only when the
                            condition becomes False
Do Until…Loop   :Continue to perform a statement or a sequence of actions if a condition is False, and stops only when the
                            condition becomes True
Do…Loop While :Performs an action or a sequence of actions once and then repeats it while a condition is True until it becomes
                            False
Do…Loop Until   : Performs an action or a sequence of actions once and then repeats it while a condition is False until it becomes
                            True
While…Wend     :Same like Do…Loop While but this one almost never see people use these days
 

In the above indefinite-iteration loop types, because you can construct the Do…Loop with the While or Until qualifiers at the beginning or at the end, it give you a lot of flexibility whether you want to execute the loop only once, given that your first condition is True at the beginning. There are some examples in the later section where you will be able to savour these looping power.
 

Return To Top

Example 1.2 another If…Then…Else statement that asks for user’s input of the value or text to select, from the active sheet’s used range. It selects all the cells that have the same value or text the user had selected. Press OK, it fills the selected cells with Green. In this example, I selected the value zero.
Dim rng As Range, iArea As Range, iRange As Range
Dim Valu As String, i As Long
Set iArea = Range(Cells(1, 1), ActiveCell.SpecialCells(xlLastCell))
Valu = InputBox("enter the value or text to select")
For Each rng In iArea
  If rng.Text = Valu Then
      If i = 0 Then
         Set iRange = rng
         i = 1
      Else
         Set iRange = Union(iRange, rng)
      End If
  End If
Next rng
iRange.Select
With Selection.Interior
  .ColorIndex = 50
  .Pattern = xlSolid
End With
 

Example 1.3 The following procedure has a rather long complex nested If…Then…ElseIf statements that I applied to one of my office work. I will show you a section of the statements so that you can more easily understand the nested If…Then…ElseIf structure which can sometimes gets very long and confusing especially for the VBA novices.  You can also download the original procedure which run base on different conditions and column of factual data, and help to make useful decisions. It then populates the outcome in the last two columns of the worksheet. In other cases, you can always combine If..Then..ElseIf statements with some other loop structure. Instead of using the Find method, you can use the InputBox method to ask for user’s input, and store the different column numbers in the variables. Note: raw data in the download example are not the true cases.

DOWNLOAD this example.

Const keep = "disagree to reduce TSL to Opt-Min: keep current TSL of "
lastrow = Cells(65536, 1).End(xlUp).Row
Rows("1:1").Cells.Find(What:="location", After:=[A1]).SelectlLoc = ActiveCell.Column
' or alternatively as,
'  loc = Range(Rows("1:1").Cells.Find(What:="location", After:=Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole, _
      SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True).Address).Column
'  or loc =  Rows("1:1").Cells.Find(What:="location", After:=Cells(1, 1).Column
cos = Rows("1:1").Cells.Find(What:="st*Cost", After:=[A1]).Column
m = Rows("1:1").Cells.Find(What:="opt*Min", After:=[A1]).Column
ec = Rows("1:1").Cells.Find(What:="event*class*", After:=[A1]).Column
summ = Rows("1:1").Cells.Find(What:="summary*", After:=[A1]).Column
ttsl = Rows("1:1").Cells.Find(What:="Total*TSL*", After:=[A1]).Column
sga = Rows("1:1").Cells.Find(What:="SG*Annual*", After:=[A1]).Column
sgm = Rows("1:1").Cells.Find(What:="SG*MOU", After:=[A1]).Column
ls = Rows("1:1").Cells.Find(What:="loc*source", After:=[A1]).Column
tpmvs = Rows("1:1").Cells.Find(What:="TPM*VIT*CE*", After:=[A1]).Column
obm = Rows("1:1").Cells.Find(What:="obsolete*mou*", After:=[A1]).Column
remk = Rows("1:1").Cells.Find(What:="*remark*", After:=[A1]).Column
align = Rows("1:1").Cells.Find(What:="align*", After:=[A1]).Column

Above loop decision is only an evaluation for ONE plant. Imagine if you have 10 plants/sites or more to evaluate?? You certainly need a loop structure programming to handle your job. Using spreadsheet filters probably will take you many hours or more than a day. Using pivot table, there is no way you can achieve this level of details and analysis to make effective decisions. No doubt about it.

Example 3.1 using Select Case statement within the For…Next loop, to find the column of std cost, then insert a column to its right, and fill in the cost category in letters base upon the values of std cost It carries on looping until the last row of data is reached.
Dim c As Integer, i As Long, lastrow As Long
lastrow = Cells(65536, 1).End(xlUp).Row
Rows("1:1").Cells.Find(What:="st*cost", After:=[A1], SearchDirection:=xlPrevious).Select
ActiveCell.Select
c = ActiveCell.Column
ActiveCell.Offset(0, 1).EntireColumn.Insert
For i = 2 To lastrow
    Select Case Cells(i, c).Value
    Case Is < 10
         Cells(i, c + 1).Value = "Cat. F"
    Case Is < 100
         Cells(i, c + 1).Value = "Cat. E"
    Case Is < 500
         Cells(i, c + 1).Value = "Cat. D"
    Case Is < 1000
         Cells(i, c + 1).Value = "Cat. C"
    Case Is < 5000
         Cells(i, c + 1).Value = "Cat. B"
    Case Else
         Cells(i, c + 1).Value = "Cat. A"
    End Select
Next

Example 3.2 using Select Case statement. The code checks for two column headers name, identify the columns and stored the values in two variables. It then inserts a column to input answers and uses “Min Level” – “Total TSL” as text case. It runs through all the conditions and take action accordingly.
Dim cMin As Integer, cTSL As Integer, i As Long, lastrow As Long
lastrow = Cells(65536, 1).End(xlUp).Row
Rows("1:1").Cells.Find(What:="Min*", After:=[A1], SearchDirection:=xlPrevious).Select
ActiveCell.Select
cMin = ActiveCell.Column
Rows("1:1").Cells.Find(What:="Total TSL*", After:=[A1], SearchDirection:=xlPrevious).Select
ActiveCell.Select
cTSL = ActiveCell.Column
ActiveCell.Offset(0, 1).EntireColumn.Insert
For i = 2 To lastrow
    Select Case Cells(i, cMin).Value - Cells(i, cTSL).Value
    Case Is = 0
         Cells(i, cTSL + 1).Value = "no mismatch"
    Case Is < 0
         Cells(i, cTSL + 1).Value = "reduce TSL?"
    Case Is > 0
         Cells(i, cTSL + 1).Value = "increase TSL?"
    Case Else
         Cells(i, cTSL + 1).Value = "others"
    End Select
Next

Example 4.1.1 a simple For… Next loop. This code will add number 99 on Cells B1,C1...to F1 and B4,C4...to G4, and so on.
Dim r As Long, c As Integer
Range("B1").Select
  For r = 0 To 2
  For c = 0 To 4
    ActiveCell.Offset(r * 3, c).Value = 99
  Next c
  Next r

 

Example 4.1.2 Fill as 1,2,3.... on alternate column, and continues with every row, using Step. Dim i As Integer, j As Integer, k As Integer For i = 1 To 10 For j = 1 To 10 Step 2    k = k + 1    Cells(i, j) = k Next j Next i
Example 4.1.3 Fill as 1,2,3.... starting from bottom up, on alternate column, and alternate row, using Step -2. Dim i As Integer, j As Integer, k As Integer k = 1 For i = 9 To 1 Step -2 For j = 10 To 1 Step -2    Cells(i, j) = k    k = k + 1 Next j Next i
Example 4.1.4 Fill as 1,3,5,7,9 on alternate column and alternate row, using  Step 2. Dim i As Integer, j As Integer For i = 1 To 10 Step 2 For j = 1 To 10 Step 2    Cells(i, j) = j Next j Next i
Example 4.1.5  Fill as 1,2,3....and so on, on alternate column and alternate row. Shade GREEN on every alternate row, from column 1 to 9. Dim i As Integer, j As Integer, k As Integer, L As Integer For i = 1 To 10 Step 2 For j = 1 To 10 Step 2    L = L + 1    Cells(i, j) = L        For k = 1 To 9  ' change columns range as you suit           Cells(i, k).Interior.ColorIndex = 4        Next k Next j Next i

Return To Top

Example 4.2 another demonstration using multiple For… Next loop. The procedure will resize 4 columns to the Right from B2, then copy the extended Range (by stepping through every 3 Rows) and paste to one cell down from the last used Cell in Column G. The code then copy values from Sheet1 cells B2,C2…E2 to column B in Sheet2, so that first value (B2) will go to B2 and C2 in B3, D2 in B4 and so on.
Dim r As Long, rDes As Long
Dim i As Long, j As Long, k As Long
With Sheets("Sheet1")
Cells(, 1).Resize(2, 5).Copy Cells(, "G")
  For r = 2 To Cells(Rows.Count, "A").End(xlUp).Row Step 4
  rDes = .Cells(Rows.Count, "G").End(xlUp).Row + 1
    Cells(r, "A").Resize(, 5).Copy Cells(rDes, "G")
  Next r
  Range("A2", Range("A2").End(xlToRight).End(xlToRight)).Copy
  Range("G2").Insert Shift:=xlDown
End With
 

’ below multiple For..Next loop shows you a way to transpose the output to Sheet2
Range("B6").Select
  For i = 0 To 2
    For j = 0 To 3
      ActiveCell.Offset(i * 4, j).Copy
      Sheets("Sheet2").Activate
      Range("B" & 2 + k).Select
      Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
      Sheets("sheet1").Activate
      k = k + 1
    Next j
  Next i

 

Example 4.3 this For…Next loop will find the value in B1 and fill in red the cells in Column A that are found to have the same value as B1.
Dim findit, r
findit = Split(Range("B1"), ",")
For r = 0 To UBound(findit)
  Columns("A:A").Select
  Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
    Formula1:=findit(r)
  Selection.FormatConditions(1).Interior.ColorIndex = 3
Next r

The syntax of a Split function is:
Split(expression [, delimiter [, count [, compare]]])

•          "Expression" is a required string expression containing substrings and delimiters.

•          "Delimiter" is an optional string identifying the delimiter character. By default, a space character (" ") is considered to be the delimiter.

•          "Count" is an optional number of substrings to return. The default is -1, which indicates all substrings are to be returned.

•          "Compare" is an optional numeric value signifying how the comparison should take place for evaluating substrings. A 0 indicates binary comparison; a 1 (the default) signifies textual comparison.

' this code explains splitting the string into 4 'parts' (by \ ) and join them back with / as in "C:/MyData/Week4/MySheet4.xls"
parts = Split("C:\MyData\Week4\MySheet4.xls", "\")
  For i = 0 To UBound(parts)
    'MsgBox parts(i)
  Next i
Debug.Print Join(parts, "/")

Return To Top

Example 5.1 using For Each...Next loop to format the used range in column B in dollar symbol and specific decimals format in #,##0.000
Dim finalrow As Long, i As Long, cel As Range

finalrow = Cells(65536, 1).End(xlUp).Row

i = 1

  For Each cel In Range("A2:A" & finalrow).SpecialCells(xlCellTypeVisible)

    i = i + 1

    Cells(i, 1).NumberFormat = "$#,##0.000"

  Next

MsgBox i & "cells formatted"
 

 

 

Example 5.2  The first For Each…Next loops through the sheets, and colors all formula cells to Red font. The nested For Each…Next loop then run through all the cells in a range, and convert anything that has the font type like “Cour*” to “Arial” font type.

Dim sht As Worksheet, c As Range

For Each sht In Sheets

    On Error Resume Next

    sht.Cells.SpecialCells(xlFormulas).Font.ColorIndex = 3

        For Each c In [A1:A100]

            If c.Font.Name Like "Cour*" Then

                c.Font.Name = "Arial"

            End If

        Next c
Next sht

 

 

 

Example 5.3 For Each...Next loop. This simple procedure deletes all the other sheets except for two sheets named “pivot” and “maindata” in the active workbook.

Dim ws As Worksheet

    Application.ScreenUpdating = False

    Application.DisplayAlerts = False

On Error GoTo Exits:

For Each ws In Worksheets

    If ws.Name <> "pivot" And ws.Name <> "maindata" Then ws.Delete

Next

Exits:

    Application.ScreenUpdating = True

    Application.DisplayAlerts = True

 

 

 

Example 5.4 For Each...Next loop. This code checks through all the sheets in the active workbook that are not the sheet name “main”, and then copy range(“A2:D8”) from all the sheets to sheet “main” at cell B2.

Dim osh As Worksheet

Set osh = Sheets("main")

For Each sh In Worksheets

    If sh.Name <> "main" Then

       sh.Range("A2:D8").Copy

       osh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 1).Select

       ActiveSheet.Paste link:=False

    End If

Next sh

Sometimes ago I did a procedure relating to my work, extending a little from the above example 5.4. This procedure copies all the sheets from path “C:\william91128\myVendors\” (you would change the path to suit) to the active workbook where you would place the code, and continue to copy all data except for headers, sheet by sheet, and append to the active sheet “main”. The formula in main sheet calculates with new data appended. You can DOWNLOAD the zip file here.

 

Return To Top

Using Do...Loop Statements

You can use Do...Loop statements to run a block of statements an indefinite number of times. The statements are repeated either while a condition is True or until a condition becomes True.

The code below will read in the entire boot.ini file. But there is no condition in that Do Loop, and so the code will keep trying to read in lines from the file, until VB throws up runtime error 62 : Input past end of file. Using a Do Until... Loop with function EOF() will resolve this problem.

Dim textLine As String
Open "c:\boot.ini" For Input As #1
Do
   Line Input #1, textLine
   Debug.Print textLine
Loop
Close #1
 

Dim textLine As String
Open "c:\autoexec.bat" For Input As #1
Do Until EOF(1)
   Line Input #1, textLine
   Debug.Print textLine
Loop
Close #1

Return To Top

Repeating Statements While a Condition is True

There are two ways to use the While keyword to check a condition in a Do...Loop statement. You can check the condition before you enter the loop, or you can check it after the loop has run at least once.

In the following ChkFirstWhile procedure, you check the condition before you enter the loop. If myNum is set to 9 instead of 20, the statements inside the loop will never run. In the ChkLastWhile procedure, the statements inside the loop run only once before the condition becomes False.

Sub ChkFirstWhile()
    counter = 0
    myNum = 20
    Do While myNum > 10
       myNum = myNum - 1
       counter = counter + 1
    Loop
    MsgBox "The loop made " & counter & " repetitions."
End Sub


 

Sub ChkLastWhile()

    counter = 0

    myNum = 9

    Do

        myNum = myNum - 1

        counter = counter + 1

    Loop While myNum > 10

    MsgBox "The loop made " & counter & " repetitions."

End Sub

 

 

' This simple code replaces all characters of " with blank and print them out line by line.
Dim dText As String, TextLine As String
Open "D:\CheeYoong\biblecode.txt" For Input As #1

   Do While Not EOF(1)
      Line Input #1, TextLine
      TextLine = Replace(TextLine, Chr$(34), "")  ' Chr$(34) is character "
      dText = dText & TextLine & vbCrLf
   Loop
'debug.print dText
TextBox1.Text = dText

 

Return To Top

Repeating Statements Until a Condition Becomes True

There are two ways to use the Until keyword to check a condition in a Do...Loop statement. You can check the condition before you enter the loop (as shown in the ChkFirstUntil procedure), or you can check it after the loop has run at least once (as shown in the ChkLastUntil procedure). Looping continues while the condition remains False.

Sub ChkFirstUntil()
    counter = 0
    myNum = 20
    Do Until myNum = 10
       myNum = myNum - 1
       counter = counter + 1
    Loop
    MsgBox "The loop made " & counter & " repetitions."
End Sub

 

Sub ChkLastUntil()

    counter = 0

    myNum = 1

    Do

       myNum = myNum + 1

       counter = counter + 1

    Loop Until myNum = 10

    MsgBox "The loop made " & counter & " repetitions."

End Sub

Return To Top

Exiting a Do...Loop Statement from Inside the Loop

You can exit a Do...Loop using the Exit Do statement. For example, to exit an endless loop, use the Exit Do statement in the True statement block of either an If...Then...Else statement or a Select Case statement. If the condition is False, the loop will run as usual.

In the following example, myNum is assigned a value that creates an endless loop. The If...Then...Else statement checks for this condition, and then exits, preventing endless looping.

Sub ExitExample()

    counter = 0

    myNum = 9

    Do Until myNum = 10

        myNum = myNum - 1

        counter = counter + 1

        If myNum < 10 Then Exit Do

    Loop

    MsgBox "The loop made " & counter & " repetitions."

End Sub

 

Example 6.1 This Do While…Loop executes the code as long as there is something in the column to the left of the active cell E2. Even though there is already a cell in E6 in the column that is not empty, the Average formula runs through and overwrites its content.
Do While Not IsEmpty(ActiveCell.Offset(0, -1))
   ActiveCell.FormulaR1C1 = "=IF(RC[-3]<500,""don't stock"",AVERAGE(RC[-2]:RC[-1]))"
   ActiveCell.Offset(1, 0).Select
Loop

Example 6.2 Do While…Loop. This macro is the same as when you try use Excel to import all the text files from a specified location, in the format that you desired, except here that I demonstrate to you that you can include it in a Do While…Loop. Change the directory to whatever is necessary.
Dim FileName As String
FileName = Dir("C:\Documents and Settings\ptan91128\SapWorkDir\*.txt")
Do While FileName <> ""
   Workbooks.OpenText _
   FileName:=FileName, _
   Origin:=xlMSDOS, _
   StartRow:=1, _
   DataType:=xlDelimited, _
   TextQualifier:=xlDoubleQuote, _
   ConsecutiveDelimiter:=True, _
   Tab:=True, _
   Semicolon:=False, _
   Comma:=False, _
   Space:=True, _
   Other:=False, _
   FieldInfo:=Array(Array(1, 1)), _
   TrailingMinusNumbers:=True
   FileName = Dir
Loop

Return To Top

Example 7.1 Do Until…Loop structure is just the opposite of Do While…Loop. Do…Until Loop runs through the statements for as long as a condition is False, stops when the condition becomes True. The example below searched down the column you had selected for the person name called “Abramovich” until it reaches a blank cell. During the search, if the match is found, it will exit the loop prematurely with Exit Do statement. The counter increases by 1 every time through the loop, and the condition following Do Until is always based on a new cell.

Sub DoUntilLoop()
Dim selectedCol As Integer, lastCol As Integer, rowCount As Integer, Match As Boolean
With Range("A1")
lastCol = Range(.Offset(0, 0), .End(xlToRight)).Columns.Count
End With

selectedCol = InputBox("select the column number from 1 to " & lastCol & " to search" _
   & "for Roman Abramovich")
rowCount = 1
Match = False
With Range("A1").Offset(0, selectedCol - 1)
' loops until a blank cell is reached.
' If Abramovich is not found in your selected column, this loop will never execute
Do Until .Offset(rowCount, 0) = vbNullString
   If .Offset(rowCount, 0) Like "*Abramovich" Then
      Match = True
      MsgBox ActiveCell.Value & vbCrLf & ActiveCell.Offset(, 1).Value & vbCrLf _
        & ActiveCell.Offset(, 2), vbInformation, "Information found"
            ' exit loop prematurely as soon as match is found
      Exit Do
   Else
      rowCount = rowCount + 1  ' without counter =1, it will be an indefinite loop
   End If
Loop
End With
   If Match = False Then
    MsgBox "no match was found"
   End If
End Sub

Return To Top

Example 8.1 Do…Loop While loop that uses a password checker that prevent unauthorized persons from running your procedure without providing the correct password in the Workbook_Open module. Of course, you would first want to lock your project procedure with a password to prevent someone from seeing the password “dobeman”.
Private Sub Workbook_Open()
Dim pwd As String
Do
    pwd = InputBox("enter password to open this workbook:", "password in characters")
    If pwd = vbNullString Then
        MsgBox "you had not entered your password"
    End If
Loop While pwd <> "dobeman"
   ' Call yourMacro
End Sub

 

Example 8.2 a simple Do…Loop While that finds all cells in a dynamic range on Sheet1 that contain the value “#N/A” and changes it to “NA”
Dim myRange As Range, c As Range, iAddress
On Error Resume Next
With Worksheets("Sheet1").Range("myRange")
    Set c = .Find("#N/A", LookIn:=xlValues)
    If Not c Is Nothing Then
        iAddress = c.Address
        Do
            c.Value = "NA"
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> iAddress
    End If
End With

Return To Top

Example 9.1 This Do…Loop Until decision loop runs as long as there is something in the column to the left of the active cell, and it does not calculate an average if there is already some cells down in the column that are not empty.
Do
  If IsEmpty(ActiveCell) Then
     ActiveCell.FormulaR1C1 = "=IF(RC[-3]<500,""don't stock"",AVERAGE(RC[-2]:RC[-1]))"
  End If
  ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Offset(0, -1))
 

 

Example 10.1  A While...Wend statement behaves like the Do While...Loop statement.
The following While...Wend counts from 1 to 100

Dim number As Integer

number = 1
While number < 100
   number = number + 1
Wend

Return To Top