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