Looping through a set range of email addresses and names to send an email depending on the pivot field

You can try this:

    Sub EmailFund1()

        Dim r As Range
        Dim SItm As SlicerItem
        Dim SItm2 As SlicerItem
        Dim cel As Range
        Dim strEmail As String
        Dim strSubject As String
        Dim intI As Integer
        Dim intJ As Integer
        Dim objRow As Range
        Dim blnExit As Boolean

        Set r = Worksheets("Fund Pivot").Range("B1")
        r.Select

        For Each objRow In Worksheets("VBA Tab").Rows
            blnExit = False

            ActiveWorkbook.EnvelopeVisible = True

            For Each SItm In ActiveWorkbook.SlicerCaches("Slicer_Fund_s").SlicerItems


                SItm.Selected = True
                For Each SItm2 In ActiveWorkbook.SlicerCaches("Slicer_Fund_s").SlicerItems
                    If SItm.Name <> SItm2.Name Then
                        SItm2.Selected = False
                    End If
                Next


                strEmail = LCase(Trim(objRow.Cells(, 2).Value))
                strSubject = UCase(Trim(objRow.Cells(, 1).Value))

                If UCase(Trim(SItm.Name)) = strSubject Then

                    With r.Parent.MailEnvelope.Item
                        .to = strEmail
                        .cc = ""
                        .bcc = ""
                        .Subject = strSubject

                        .send

                    End With

                   'We have found the email, we can exit the for loop.
                   Exit For
               ElseIf Len(strSubject) < 1 Then
                   'Reached the end. exit loop
                   blnExit = True
               End If
           Next

           If blnExit Then Exit For
        Next

        Set r = Nothing

    End Sub