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