Looping Through Worksheets Excluding Specified Worksheets

Question

I want to grab data from specified worksheets within a single workbook and then create individual emails from those sheets.

The code doesn't execute the operation for each worksheet and then move to the next.

I also want to exclude specified worksheets from the operation.

I am leveraging Ron DeBruin's RangetoHtml function in a separate module.

Sub ClientEvent_Email_Generation()
    
    Dim OutApp As Object
    Dim OutMail As Object
    Dim count_row, count_col As Integer
    Dim Event_Table_Data As Range
    Dim Event2_Table_Data As Range
    Dim strl As String, STR2 As String, STR3 As String
    Dim WS As Worksheet
    Dim I As Integer
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    For Each WS In ThisWorkbook.Sheets
    
    WS.Activate
    
    If ActiveSheet.Name <> "DATA INPUT" Then Or "FORMATTED DATA TABLE" Or "REP CODE MAPPING TABLE" Or "IDEAS TAB" Then
    
    count_row = WorksheetFunction.CountA(Range("A10", Range("a10").End(xlDown)))
    count_col = WorksheetFunction.CountA(Range("A10", Range("a10").End(xlToRight)))
    
    Set Event_Table_Data = ActiveSheet.Cells.Range(Cells(9, 1), Cells(count_row, count_col)) 
    Set Event2_Table_Data = Sheets("w61").Range(Cells(9, 1), Cells(count_row, count_col)) 
    
    str1 = "<BODY style=font-size:12pt;font-family:Times New Roman>" & _
    "Hello " & Range("L3").Value & ",<br><br>The following account(s) listed below appear to have an upcoming event<br>"
    
    STR2 = "<br>Included are suggestions for an activity which may fit your client's needs.<br>"
    
    STR3 = "<br>You may place an order, or contact us for alternate ideas if these don't fit your client."
    
    On Error Resume Next
        With OutMail
        .To = ActiveSheet.Range("l4").Value
        .cc = ""
        .bcc = ""
        .Subject = "Upcoming Event  In Your Clients' Account(s)"
        .display
        .HTMLBody = str1 & RangetoHTML(Event_Table_Data) & STR2 & RangetoHTML(Event2_Table_Data) & STR3 & .HTMLBody
        
        End With
        On Error GoTo 0
    
    Set OutMail = Nothing
    Set OutApp = Nothing
    
    End If
    
    Next WS
    
End Sub

You need to qualify ALL your range and cell references: `WorksheetFunction.CountA(WS.Range(` and `WS.Cells.Range(WS.Cells(` for example. Why are you sometimes using `ActiveSheet` and sometimes using `WS` if they are the same thing? — braX, May 12 '21 at 20:54
You have an extra Then where it isn't needed so this code won't even compile: `If ActiveSheet.Name <> "DATA INPUT" Then Or "FORMATTED DATA TABLE"...` You only need the Then at the very end of that line — barrowc, May 12 '21 at 21:04

score 0 · Answer 1 · answered May 13 '21 at 00:38

Loop (Iterate) Through Worksheets

The following will loop through each worksheet in the workbook containing this code (ThisWorkbook) and print each worksheet name that is not included in the Exceptions List (Exceptions array) and the 'non-empty' range starting with cell A9 to the Immediate window (VBE: Ctrl+G.
Run it first as-is to see if the result is satisfactory and only then add your email code (which is unclear) where you need to qualify the ranges and cells i.e. use ws instead of ActiveSheet and ws. in front of Cells or Range (ws.Cells(...), ws.Range(...) if any of it is, or is part of the current worksheet in the loop.
There may be more reliable ways (see this answer to Error in finding last used cell in Excel with VBA) to define (create a reference to) the range, but the focus here is set on the loop (using ACount is even less reliable).

Option Explicit

Sub loopThroughWorksheets()
    
    Const sFirst As String = "A9"
    Const ExceptionsList As String _
        = "DATA INPUT,FORMATTED DATA TABLE,REP CODE MAPPING TABLE,IDEAS TAB"
    
    Dim Exceptions() As String: Exceptions = Split(ExceptionsList, ",")
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim sws As Worksheet
    Dim srg As Range ' "Event_Table_Data"
    Dim fCell As Range
    Dim rCount As Long, cCount As Long
    
    For Each sws In wb.Worksheets
        If IsError(Application.Match(sws.Name, Exceptions, 0)) Then
            Set fCell = sws.Range(sFirst)
            rCount = sws.Range(fCell, fCell.End(xlDown)).Cells.Count
            cCount = sws.Range(fCell, fCell.End(xlToRight)).Cells.Count
            Set srg = fCell.Resize(rCount, cCount)
            ' e.g.:
            Debug.Print sws.Name, srg.Address
            
            ' Your email code (per worksheet) here.
        
        'Else
            ' Worksheet is in Exceptions Array: do nothing, or...
        End If
    Next sws

End Sub

Looping Through Worksheets Excluding Specified Worksheets

1 Answers1

Loop (Iterate) Through Worksheets