How to call subroutine that references SpecialCells?

Question

I built a script to create emails addressed to different people with individual attachments included. I have different subroutines that are called from this Mother Script.

It works until the subroutine Distribution is called. It stops at

For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

Sub Distribution()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm

    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim cell As Range
    Dim FileCell As Range
    Dim rng As Range
    Dim StrBody As String
    
    StrBody = "<BODY style=font-size:11pt;font-family:Arial>Hi team," & "<br><br>" & _
              "Please find attached the most updated version of the Weekly Report. " & "<br>" & _
              "If you have any doubt or comment, do not hesitate to reach out to us." & "<br><br>" & _
              "Jorge Martinez"
                
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set sh = Sheets("Sheet1")

    Set OutApp = CreateObject("Outlook.Application")

    Windows("Free Trade Zone Weekly Reports.xlsm").Activate

    For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

        'Enter the path/file names in the C:Z column in each row
        Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")

        If cell.Value Like "?*@?*.?*" And _
           Application.WorksheetFunction.CountA(rng) > 0 Then
            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                .to = cell.Value
                .CC = "tulio.paz@diageo.com"
                .Subject = "Weekly Report " & Date
                Bodyformat = 2
                '.Body = "<BODY style=font-size:11pt;font-family:Arial>Hi team," & "<br><br>" & _
              "Please find attached the most updated version of the Weekly Report " & "<br>" & _
              "If you have any doubt or comment, do not hesitate to reach out to us." & "<br><br>" & cell.Offset(0, -1).Value
                .Importance = 2
                   .HTMLBody = StrBody & cell.Offset(0, -1).Value

                For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                    If Trim(FileCell) <> "" Then
                        If Dir(FileCell.Value) <> "" Then
                            .Attachments.Add FileCell.Value
                        End If
                    End If
                Next FileCell

                .Display  'Or use .Display
            End With

            Set OutMail = Nothing
        End If
    Next cell

    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    
End Sub

I took it from Ron DeBruin's website.

The error is:

no data in selected cells.

If I stop the mother script and run this subroutine independently, it goes without any type of issue.

I thought it would be fixed by activating the workbook that contains the script prior to that line, but no success.

Answer 1

When working with SpecialCells you have to be very careful. Try this

Replace

For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

with

Dim rng As Range

On Error Resume Next
Set rng = sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
On Error GoTo 0

If rng Is Nothing Then
    MsgBox "No Range with constants were found"
    Exit Sub
End If

For Each cell In rng

How to call subroutine that references SpecialCells?

Question

1 answers

solution1
2 ACCPTED 2021-01-27 14:52:19

How to call subroutine that references SpecialCells?

Question

1 answers

solution1 2 ACCPTED 2021-01-27 14:52:19

solution1
2 ACCPTED 2021-01-27 14:52:19