Skip to content

Excel VBA – For Each Next Loops (Looping through Collections)

    For Each Next loops allow you to loop through a collection and perform the same action on all objects within that collection. For example, you might want to close all workbooks in the Workbooks collection or protect all sheets in Worksheets collection or format all cells within a specified range.

    The structure of a For Each Next loop is as follows:

    For Each Element in Collection
      Set of instructions
Next Element

    Here are some examples of For Each Next loops and how they might be used for workbooks, worksheets, ranges and charts.

    Workbooks

    Close All Open Workbooks

    This procedure closes and saves all workbooks except the one with the macro in.

    Sub CloseAllWorkbooksExceptThisOne()
Dim wb As Workbook
For Each wb In Workbooks
    If wb.Name <> ThisWorkbook.Name Then
        wb.Close SaveChanges:=True
    End If
Next wb
End Sub

    Save All Open Workbooks

    This procedure saves all workbooks that need saving and have a file path (have previously been saved).

    Sub SaveallWorkbooks()
Dim wb As Workbook
For Each wb In Workbooks
    'check to see if the workbook needs saving
    If wb.Saved <> True Then
        'check to see if the workbook has been saved before
        If wb.Path <> "" Then
            wb.Save
        End If
    End If
Next wb
End Sub

    Worksheets

    Protecting/Unprotecting All Sheets

    This procedure protects all sheets in a workbook.

    Sub ProtectSheets()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    ws.Protect
Next ws
End Sub

    This procedure unprotects all sheets in a workbook.

    Sub UnProtectSheets()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
	ws.Unprotect
Next ws
End Sub

    Create a New Workbook for Each Worksheet

    This procedure creates a new workbook for each sheet in the current workbook.

    Sub CreateNewWorkBookForEachSheet()
Dim ws As Worksheet
Dim wb As Workbook
Dim Path As String
Path = "C:\Users\chest\Documents\Finance"

For Each ws In ThisWorkbook.Worksheets
Set wb = Workbooks.Add
    wb.SaveAs Path & "\" & ws.Name
    ws.Copy Before:=wb.Worksheets(1)
    wb.Close SaveChanges:=True
Next ws

End Sub

    Unhide All Worksheets

    This procedure unhides all sheets in the current workbook.

    Sub UnHideSheets()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    ws.Visible = xlSheetVisible
Next ws
End Sub

    Format/Protect All Formulas in a Workbook

    This procedure protects all cells containing a formula by looping through each sheet and unlocking cells that don’t contain formula. The sheets are then protected.

    Sub ProtectFormulaOnEachSheet()
Dim ws As Worksheet
'if constants or formula not found on a sheet continue to next
On Error Resume Next

For Each ws In ThisWorkbook.Worksheets
    'unlock cells containing constants
    ws.Cells.SpecialCells(xlCellTypeConstants).Locked = False
    'format cells with formula with a yellow background
    ws.Cells.SpecialCells(xlCellTypeFormulas).Interior.Color = vbYellow
    'protect the worksheet
    ws.Protect
Next ws

End Sub

    Create a New Workbook for Each Worksheet

    This procedure creates a new workbook for each worksheet in the current workbook.

    Sub CreateNewWorkbookForEachSheet()
Dim ws As Worksheet
Dim Addwb As Workbook
Dim MyPath As String
MyPath = ThisWorkbook.Path & "/For Each Workbooks"
'Make a folder for the new workbooks
MkDir MyPath
'Turn off alerts (if you don't you will be required to confirm sheet deletion)
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Worksheets
    'Create a new workbook and save it
    Set Addwb = Workbooks.Add
    Addwb.SaveAs MyPath & "/" & ws.Name
    'Copy the sheet to the new workbook
    ws.Copy before:=Addwb.Worksheets("Sheet1")
    'Delete Sheet1 in the new workbook
    Addwb.Worksheets("Sheet1").Delete
    'Close and save the new workbook
    Addwb.Close SaveChanges:=True
Next ws
'Turn alerts back on
Application.DisplayAlerts = True
End Sub

    Replace Data Across Multiple Worksheets

    This procedure replaces the name of a store location across specified worksheets in the same workbook.

    Sub ReplaceDataAcrossSheets()

Dim ws As Worksheet
'Use the variant data type to store an array of worksheets
Dim Replacews As Variant
'Define the array of worksheets that you want to replace data in
Set Replacews = Worksheets(Array("Replace Sheet1", _
"Replace Sheet2", "Replace Sheet3"))
'replace data with data
For Each ws In Replacews
    ws.UsedRange.Replace What:="Brighton", Replacement:="Bristol"
Next ws

End Sub

    Ranges

    Format Cells  within a Range

    This procedure formats all cells in the specified range with a red background.

    Sub FormatCellsinRange()
Dim rg As Range
Dim list As Range
Set list = Range("A1", Range("A1").End(xlDown))
For Each rg In list
    rg.Interior.Color = vbRed
Next rg
End Sub

    Trim Values

    This procedure Trims values in a Product list as would the Trim function in Excel.  VBA contains 3 Trim functions but none of them Trim superflous spaces between characters which is why the procedure uses the worksheet function instead.

    Sub TrimValues()
Dim rg As Range, ProductList As Range
Set ProductList = Range("F2", Range("F2").End(xlDown))
For Each rg In ProductList
    rg = WorksheetFunction.Trim(rg)
Next rg
End Sub

    The code above relates to the data shown below.

    Concatenate Text to Values in a List

    This procedure adds the string “ABC-“ to the beginning of product codes in a list.

    Sub ConcatenateProductCodes()
Dim rg As Range, ProductCodes As Range
Set ProductCodes = Range("F2", Range("F2").End(xlDown))
For Each rg In ProductCodes
    rg = "ABC-" & rg
Next rg
End Sub

    The code above relates to the data shown below.

    Perform a Calculation on Values in a List

    This procedure calculates price inclusive of VAT one column to the right of a price list.

    Sub AddVAT()
Const VAT As Single = 0.2
Dim rg As Range
Dim PriceList As Range
Dim PriceIncVAT As Currency
Set PriceList = Range("B2", Range("B2").End(xlDown))

For Each rg In PriceList
    With rg.Offset(0, 1)
        .Value = rg * (1 + VAT)
        .NumberFormat = "£#,##0.00"
    End With
Next rg

End Sub

    The code above relates to the data shown below.

    Apply Alternate Row Formatting

    This procedure formats cells with a yellow background, if the cell’s row number is even.  The Row property of the Range object returns the row number.

    Sub AlternateRowFormatting()

Dim PriceList As Range, rg As Range
Set PriceList = Range("A2", Range("A2").End(xlToRight).End(xlDown))

For Each rg In PriceList.Rows
    If WorksheetFunction.IsEven(rg.Row) Then
        rg.Interior.Color = vbYellow
    End If
Next rg
End Sub

    The code above relates to the data shown below.

    Format Cells Based on Data Type

    This procedure formats cells based on data type – number, text, error, logical etc.

    Sub FormatCellsBasedonDataType()
Dim rg As Range
Dim list As Range
Set list = Range("A1:A8")

For Each rg In list
    Select Case True
        Case Is = WorksheetFunction.IsError(rg)
        rg.Interior.Color = vbCyan
        Case Is = IsEmpty(rg)
        rg.Interior.Color = vbBlack
        Case Is = WorksheetFunction.IsFormula(rg)
        rg.Interior.Color = vbRed
        rg.Font.Color = vbWhite
        Case Is = WorksheetFunction.IsText(rg)
        rg.Interior.Color = vbGreen
        Case Is = WorksheetFunction.IsNumber(rg)
        rg.Interior.Color = vbYellow
        Case Is = WorksheetFunction.IsLogical(rg)
        rg.Interior.Color = vbBlue
        rg.Font.Color = vbWhite
    End Select
Next rg

End Sub

    The code above relates to the data displayed below.

    Charts

    This procedure loops through the collection of the chart objects on Sheet1 and adds a title to each chart.

    Sub TitleCharts()
Dim AChart As ChartObject
Dim LastYear As String
Dim FirstYear As String
Dim ChartData As Range
Set ChartData = Range("A3").CurrentRegion

For Each AChart In Sheet1.ChartObjects
    FirstYear = Range("a3").Offset(0, 1).Value
    LastYear = Range("a3").End(xlToRight).Value
    With AChart.Chart
        .SetSourceData ChartData
        .HasTitle = True
        .ChartTitle.Select
        .ChartTitle.Text = "Sales " & FirstYear & " to " & LastYear
        .HasLegend = True
    End With
Next

End Sub

    The code above relates to the data shown below.

    Nested For Each Next

    This procedure formats cells based on data type on all sheets in the current workbook.  It uses two For Each Next loops.  The first For Each Next loop loops through all worksheets in the current workbook. The second For Each Next loop is nested in the first and loops through each cell in the used part of the worksheet.

    Sub FormatCellsBasedonDataTypeAcrossWorkbooks()
Dim rg As Range
Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
    For Each rg In ws.UsedRange
        Select Case True
            Case Is = WorksheetFunction.IsError(rg)
            rg.Interior.Color = vbCyan
            Case Is = IsEmpty(rg)
            rg.Interior.Color = vbBlack
            Case Is = WorksheetFunction.IsFormula(rg)
            rg.Interior.Color = vbRed
            rg.Font.Color = vbWhite
            Case Is = WorksheetFunction.IsText(rg)
            rg.Interior.Color = vbGreen
            Case Is = WorksheetFunction.IsNumber(rg)
            rg.Interior.Color = vbYellow
            Case Is = WorksheetFunction.IsLogical(rg)
            rg.Interior.Color = vbBlue
            rg.Font.Color = vbWhite
        End Select
    Next rg
Next ws

End Sub