Making a Macro repeat

[thardin17]

I have a macro I have written that works with the data in the first row of my worksheet. I need the macro to run on that rows data and then repeat itself using the next row's data. So it works in row 2 as written but I need it to run in row 2 and then repeat to row 3 and so on to the end of my sheet. Is this possible and if so how?

Sub DataCheck2()

If Range("J2").Value = "Time to call" Then Call FinalEmail2

End Sub



Sub FinalEmail2()

Dim emailApplication As Object
Dim emailItem As Object


Set emailApplication = CreateObject("Outlook.Application")
Set emailItem = emailApplication.CreateItem(0)


emailItem.to = "troy_hardin@zeeco.com"

emailItem.Subject = "Tickler File Alert"

emailItem.Body = "Contact" & " " & Range("A2") & " " & Range("B2") & " " & "about their" & " " & Range("C2").Value

emailItem.display

Set emailItem = Nothing
Set emailApplication = Nothing


End Sub

 

[Michael M]

Maybe this UNTESTED...only one macro not 2 as posted originally

Sub MM1()
Dim emailApplication As Object, emailItem As Object
Dim lr As Long, r As Long
Set emailApplication = CreateObject("Outlook.Application")
Set emailItem = emailApplication.CreateItem(0)
lr = Cells(Rows.Count, "J").End(xlUp).Row 'adjust column as required, currently column "J"
    For r = 2 To lr
        If Range("J" & r).Value = "Time to call" Then
            emailItem.To = "troy_hardin@zeeco.com"
            emailItem.Subject = "Tickler File Alert"
            emailItem.Body = "Contact" & " " & Range("A" & r) & " " & Range("B" & r) & " " & "about their" & " " & Range("C" & r).Value
            emailItem.display
            Set emailItem = Nothing
            Set emailApplication = Nothing
        End If
    Next r
End Sub

 

[mart37]

Sub DataCheck2()
    Dim lastrow As Long
    Dim c As Range
    lastrow = ActiveSheet.Range("J" & Rows.Count).End(xlUp).Row
    For Each c In ActiveSheet.Range("J2:J" & lastrow)
        If c.Value = "Time to call" Then Call FinalEmail2(c.Row)
    Next
End Sub

Sub FinalEmail2(r As Long)
    Dim emailApplication As Object
    Dim emailItem As Object
    Set emailApplication = CreateObject("Outlook.Application")
    Set emailItem = emailApplication.CreateItem(0)
    emailItem.to = "troy_hardin@zeeco.com"
    emailItem.Subject = "Tickler File Alert"
    emailItem.Body = "Contact" & " " & Range("A" & r) & " " & Range("B" & r) & " " & "about their" & " " & Range("C" & r).Value
    emailItem.display
    Set emailItem = Nothing
    Set emailApplication = Nothing
End Sub

 

[thardin17]

Sub DataCheck2()
    Dim lastrow As Long
    Dim c As Range
    lastrow = ActiveSheet.Range("J" & Rows.Count).End(xlUp).Row
    For Each c In ActiveSheet.Range("J2:J" & lastrow)
        If c.Value = "Time to call" Then Call FinalEmail2(c.Row)
    Next
End Sub

Sub FinalEmail2(r As Long)
    Dim emailApplication As Object
    Dim emailItem As Object
    Set emailApplication = CreateObject("Outlook.Application")
    Set emailItem = emailApplication.CreateItem(0)
    emailItem.to = "troy_hardin@zeeco.com"
    emailItem.Subject = "Tickler File Alert"
    emailItem.Body = "Contact" & " " & Range("A" & r) & " " & Range("B" & r) & " " & "about their" & " " & Range("C" & r).Value
    emailItem.display
    Set emailItem = Nothing
    Set emailApplication = Nothing
End Sub

Thank you so much for the help. It works perfectly!!

 

[thardin17]

Maybe this UNTESTED...only one macro not 2 as posted originally

Sub MM1()
Dim emailApplication As Object, emailItem As Object
Dim lr As Long, r As Long
Set emailApplication = CreateObject("Outlook.Application")
Set emailItem = emailApplication.CreateItem(0)
lr = Cells(Rows.Count, "J").End(xlUp).Row 'adjust column as required, currently column "J"
    For r = 2 To lr
        If Range("J" & r).Value = "Time to call" Then
            emailItem.To = "troy_hardin@zeeco.com"
            emailItem.Subject = "Tickler File Alert"
            emailItem.Body = "Contact" & " " & Range("A" & r) & " " & Range("B" & r) & " " & "about their" & " " & Range("C" & r).Value
            emailItem.display
            Set emailItem = Nothing
            Set emailApplication = Nothing
        End If
    Next r
End Sub

This worked on the first row as before but generated an error on the second run. Thanks for the assist.