VBA execute cell function

[thomas819]

Hello all,
I am trying create an VBA script which will go through all cells in range H2:H210. When condition is met, VBA should execute a function which is written in that specific cell. Function is hyperlink to send customized email.

Example of this hyperlink:

HYPERLINK("mailto:"&INDEX($N$2:$N$10;MATCH(F12;$M$2:$M$10;0))&"?subject="&"Expiration of "&A12&"&body="&A12&" - "&B12&" >>> projekt: "&C12&" ("&D12&") %0A                is due to exprirate on "&TEXT(J12;"dd.mm.yyyy")&"%0A%0ABest regards";"reminder")

INDEX($N$2:$N$10 >>> list of emails
;MATCH(F12 >>> surname
;$M$2:$M$10 >>> list of surnames
;0))

I am struggle only with this iniciating sequence of VBA. I can't force VBA to execute function stored in cell.
At this moment I have to manually click on cell in which condition is met. When I clicked on cell (hyperlink "reminder"), email is send nice and easy.

One more issue... It's possible to run VBA in following manner:
Within VBA condition is met, hyperlink in that specific cell is trigger, email is send.... then VBA will continue in looping process in this manner until end of range

 

[EFANYoutube]

If you know the cell reference you can simply do this

Range("A1").Hyperlinks(1).Follow

 

[EFANYoutube]

Do you need help writing the rest?

 

[thomas819]

Do you need help writing the rest?

Yes please ? Do tou need more info? Or anything elese?

 

[EFANYoutube]

Yeah, so I will need the condition and what happens when VBA opens 208 email windows?

 

[thomas819]

Yeah, so I will need the condition and what happens when VBA opens 208 email windows?

Hello EFANY, thank you for your reply

When I use this condition:

    For i = 2 To LastRow
        myValue = Range("E" & i).Value
            If (myValue + limit) < Date Then Range("P" & i).Value = i

I got correct row number and in a fact I need send email only to those specific rows. So far so good.


Here is a complete code, which I created so far.

Sub test()

    Dim sh As Worksheet
    Dim i As Long
    Dim limit As Long
    Dim LastRow As Long
    Dim myValue As Long
    Dim OA As Object
    Dim emsg As Object
    
   Set sh = ThisWorkbook.Sheets("Reminder")
   Set OA = CreateObject("Outlook.Application")
    
LastRow = sh.Range("A2").End(xlDown).Row
limit = sh.Range("N7").Value
    
    For i = 2 To LastRow
        myValue = Range("E" & i).Value
        Set emsg = OA.createitem(0)
              emsg.To = WorksheetFunction.Index(sh.Range("N2:N4"), _
                                WorksheetFunction.Match(sh.Range("F" & i).Value, sh.Range("M2:M4"), 0))
              emsg.Subject = "Expiration of " & sh.Range("A" & i).Value
              emsg.body = sh.Range("A" & i).Value & " - " & sh.Range("B" & i).Value & " >>> projekt: " & sh.Range("C" & i).Value & " (" & sh.Range("D" & i).Value & ")                 is due to exprirate on " & WorksheetFunction.Text(sh.Range("J" & i).Value, "dd.mm.yyyy") & " Best regards"
              emsg.send
    Next i
End Sub

I don't know how should I implemented my condition...

Could you help me?

Final version of this VBA should be able to do following...

When I run it, it should send an customized email made from information in those rows in which my condition is met.

 

[EFANYoutube]

Looks like you need it like this?

Sub test()

    Dim sh As Worksheet
    Dim i As Long
    Dim limit As Long
    Dim LastRow As Long
    Dim myValue As Long
    Dim OA As Object
    Dim emsg As Object
    
   Set sh = ThisWorkbook.Sheets("Reminder")
   Set OA = CreateObject("Outlook.Application")
    
LastRow = sh.Range("A2").End(xlDown).Row
limit = sh.Range("N7").Value
    
    For i = 2 To LastRow
        myValue = Range("E" & i).Value
        If (myValue + limit) < Date Then
            Range("P" & i).Value = i
            Set emsg = OA.createitem(0)
                  emsg.To = WorksheetFunction.Index(sh.Range("N2:N4"), _
                                    WorksheetFunction.Match(sh.Range("F" & i).Value, sh.Range("M2:M4"), 0))
                  emsg.Subject = "Expiration of " & sh.Range("A" & i).Value
                  emsg.body = sh.Range("A" & i).Value & " - " & sh.Range("B" & i).Value & " >>> projekt: " & sh.Range("C" & i).Value & " (" & sh.Range("D" & i).Value & ")                 is due to exprirate on " & WorksheetFunction.Text(sh.Range("J" & i).Value, "dd.mm.yyyy") & " Best regards"
                  emsg.send
        End If
    Next i
End Sub

 

[thomas819]

Hi Efany,
when I tried your solution I got a correct answer into the column P which is fine, but somehow VBA send email from every single row... Which is not desired at all...

I need send email only to rows in which condition is met...

Can you help me with this issue, please?

 

[thomas819]

Correct code :

Sub test()

    Dim sh As Worksheet
    Dim i As Long
    Dim limit As Long
    Dim LastRow As Long
    Dim myValue As Long
    Dim OA As Object
    Dim emsg As Object
    
   Set sh = ThisWorkbook.Sheets("Reminder")
   Set OA = CreateObject("Outlook.Application")
    
LastRow = sh.Range("A2").End(xlDown).Row
limit = sh.Range("N7").Value
    
    For i = 2 To LastRow
        myValue = Range("E" & i).Value
            Set emsg = OA.createitem(0)
               If (myValue + limit) < Date Then
                  emsg.To = WorksheetFunction.Index(sh.Range("N2:N4"), _
                                    WorksheetFunction.Match(sh.Range("F" & i).Value, sh.Range("M2:M4"), 0))
                  emsg.Subject = "Expiration of " & sh.Range("A" & i).Value
                  emsg.body = sh.Range("A" & i).Value & " - " & sh.Range("B" & i).Value & " >>> projekt: " & sh.Range("C" & i).Value & " (" & sh.Range("D" & i).Value & ")                 is due to exprirate on " & WorksheetFunction.Text(sh.Range("J" & i).Value, "dd.mm.yyyy") & " Best regards"
                  emsg.send
        End If
    Next i
End Sub

Thank you for your help

 

[EFANYoutube]

Glad you worked it out