Is there a function to skip outfiltered rows when running a code in VBA?-CodePudding

I have developed a template with which I can automate invoice reminders by outputting emails. Currently the code loops through the list outputting an email for each individual row (= each individual invoice). I would like to update the code so that it skips outfiltered rows in the excel doc to make it more efficient and easier in use.

My code is as follows:

Sub Send_email_fromtemplate()
Dim edress As String
Dim cc1, cc2, cc3 As String
Dim group As String
Dim number As String
Dim outlookapp As Object
Dim outlookmailitem As Object
Dim r As Long
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object

 r = 3

Do While Sheet1.Cells(r, 1) <> ""
    Set outlookapp = CreateObject("Outlook.Application")
    'call your template
    Set outlookmailitem = outlookapp.CreateItemFromTemplate([location])
    outlookmailitem.Display

    edress = Sheet1.Cells(r, 7)
    cc1 = Sheet1.Cells(r, 8)
    cc2 = Sheet1.Cells(r, 9)
    cc3 = Sheet1.Cells(r, 10)
    group = Sheet1.Cells(r, 4)
    number = Sheet1.Cells(r, 3).Value
    With outlookmailitem
       .To = edress
        .cc = cc1 & ";" & cc2 & ";" & cc3
        .bcc = ""
        .Subject = "First invoice reminder " & group
        
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        With oRng.Find
            Do While .Execute(FindText:="{{Number}}")
                oRng.Text = number
                Exit Do
            Loop
        End With
        Set xInspect = outlookmailitem.GetInspector
  
       .Display
        '.send
    End With
    'clear your email address
    edress = ""
    
    r = r   1
    
Loop
'clear your fields
Set outlookapp = Nothing
Set outlookmailitem = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
End Sub

I've tried to solve the problem using a Range function and ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible), but as the template will be filled with a variable number of rows (each time I send reminders) this is causing troubles, as the range differs each time.

CodePudding user response：

Please, try the next updated code. As I said in my above comment, it is able to calculate the last row on A:A, then create a range from visible rows of the filtered area and iterate between its rows:

Sub Send_email_fromtemplate()
 Dim edress As String, cc1 As String, cc2 As String, cc3 As String
 Dim group As String, number As String
 Dim outlookapp As Object, outlookmailitem As Object, olInsp As Object
 Dim wdDoc As Object, xInspect As Object
 Dim oRng As Object, lastR As Long, rngVis As Range, r As Range

lastR = Sheet1.Range("A" & Sheet1.rows.count).End(xlUp).row 'last row on A:A
On Error Resume Next 'this is necessary in case of no any filtered visible cell
  Set rngVis = Sheet1.Range("A3:J" & lastR).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
 If rngVis Is Nothing Then MsgBox "No visible filtered values in the necessary range...": Exit Sub

 Set outlookapp = CreateObject("Outlook.Application") 'you should set it only ones, outside of the iteration...
 For Each r In rngVis.rows 'iterate between the discontinuous (visible cells) rows
    'call your template
    Set outlookmailitem = outlookapp.CreateItemFromTemplate([Location])
    outlookmailitem.Display

    edress = r.cells(1, 7) 'extract the necessary values from the iterated row
    cc1 = r.cells(1, 8)
    cc2 = r.cells(1, 9)
    cc3 = r.cells(1, 10)
    group = r.cells(1, 4)
    number = r.cells(1, 3).Value
    With outlookmailitem
       .To = edress
        .cc = cc1 & ";" & cc2 & ";" & cc3
        .BCC = ""
        .Subject = "First invoice reminder " & group
        
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        With oRng.Find
            Do While .Execute(FindText:="{{Number}}")
                oRng.Text = number
                Exit Do
            Loop
        End With
        Set xInspect = outlookmailitem.GetInspector
  
       .Display
        '.send
    End With
    'clear your email address
    edress = ""
 Next r

 'clear memory of used objects:
 Set outlookapp = Nothing: Set outlookmailitem = Nothing
 Set wdDoc = Nothing: Set oRng = Nothing
End Sub

Please, send some feedback after testing it.