Do loops allow you to repeat code over and over again.  All you need to do is put your code between the Do and Loop statements.

Structure for a Do Loop

Do
	Set of Instructions
Loop

A Do Loop normally needs some kind of condition or rule to tell it whether to keep looping or when to stop, otherwise it will keep looping forever. You can use Do While or Do Until statements to set the condition.

Do While your condition
	Set of instructions
Loop

Or

Do 
	Set of instructions
Loop While your condition

Note the Loop While version will always perform the first loop, whereas the Do While version will only perform the first loop if the condition is met.

Do Loop Without Criteria Example

In this example the Do Loop will format cells with a green background.  As there is no condition to tell the loop when it should stop it will keep formatting cells until it reaches the bottom of column A.

Sub DoLoopWithoutCriteria()
Range("A1").Select
Do
    ActiveCell.Interior.Color = vbGreen
    ActiveCell.Offset(1, 0).Select
Loop
End Sub

Do Loop With Criteria Examples

In the following examples we only want the cells with values less than 10 to be formatted with a green background.

The following examples relates to the data shown below.

This example uses a Do Until statement to set a condition.

Sub DoUntil()
Range("A1").Select
Do Until ActiveCell = 10
    ActiveCell.Interior.Color = vbGreen
    ActiveCell.Offset(1, 0).Select
Loop
End Sub

The next example uses a Do While statement to set a condition.

Sub DoWhile()
Range("A1").Select
Do While ActiveCell < 10
    ActiveCell.Interior.Color = vbGreen
    ActiveCell.Offset(1, 0).Select
Loop
End Sub

The final example uses and an If with an Exit Do statement to set a condition.

Sub LoopWithExitDo()
Range("A1").Select
Do
    If ActiveCell = 10 Then Exit Do
    ActiveCell.Interior.Color = vbGreen
    ActiveCell.Offset(1, 0).Select
Loop
End Sub

Do While Vs Loop While

Be careful how you use Loop While or Loop Until.  For example the procedure below would format the first cell with a green background even though it doesn’t meet the Loop While criteria. This is because the first loop will always be performed when you use a Loop While or Loop Until loop.

Sub DoWhileVsLoopWhile()
Dim x As Byte
x = 1
    Do
        Cells(x, 1).Interior.Color = vbGreen
        x = x + 1
    Loop While Cells(x, 1) < 10      
End Sub

The code above relates to the data shown below.

Random Numbers Example

In this example the user specifies how many loops the Do Until loop should perform. The variable x is used to store the number of loops that have occurred.

Sub RandomNumbers()
Dim x As Byte
Dim NumberofRandomNumbers As Long
NumberofRandomNumbers = InputBox("How many random numbers do you need?")
Range("A2").Activate
Do Until x = NumberofRandomNumbers
    ActiveCell.Offset(x, 0) = WorksheetFunction.RandBetween(1, 100)
    x = x + 1
Loop
End Sub

Transpose Records Example

A classic use of the Do loop is to perform the same set of actions in a worksheet until the code reaches an empty cell.  In this example we want to transpose data so it appears in database format.

Sub TransposeRecords()
Range("A3").Select

Do While ActiveCell <> Empty
    ActiveCell.Resize(13, 1).Copy
    ActiveCell.Offset(-1, 0).PasteSpecial Transpose:=True
    ActiveCell.Offset(1, 0).Resize(13, 1).EntireRow.Delete
    ActiveCell.Offset(1, 0).EntireRow.Insert
    ActiveCell.Offset(2, 0).Select
Loop

End Sub

The code above relates to the data shown below.

Archive Records Example

This example archives training records to another worksheet. See code comments for explanation.

Sub ArchiveRecords()
'Create a new worksheet called Archived Records
Worksheets.Add(after:=Worksheets("Training Records")).Name = "Archived Records"
'Copy the headings to the Archived Records worksheet
Worksheets("Training Records").Range("A1").Resize(1, 3).Copy
With Worksheets("Archived Records").Range("A1")
    .PasteSpecial xlPasteColumnWidths
    .PasteSpecial
End With
'Sort the data in date order
Worksheets("Training Records").Activate
Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes

Range("A2").Select
'Loop through all training records and archive past records
Do While ActiveCell.Value < Date
    ActiveCell.Resize(1, 3).Copy
    Worksheets("Archived Records").Activate
    ActiveCell.Offset(1, 0).PasteSpecial
    Worksheets("Training Records").Activate
    ActiveCell.EntireRow.Delete
Loop

Application.CutCopyMode = False
End Sub

The code above relates to the data shown below.