VBA Not running automatically

daddyfoxuk

Board Regular
Joined
Nov 18, 2016
Messages
68
So i have the below codes... When i hit F5 the code will run perfectly although i would like it to include cell A,B,C and D in the email body. But i want this to run every time the value of any cells in I going above 1.... Can anyone help as to whys it isnt running, kinda doing my head in now haha!

On Sheet4 (Bad Parts)
Code:
Private Sub Worksheet_Calculate()
    Dim FormulaRange As Range
    Dim NotSentMsg As String
    Dim MyMsg As String
    Dim SentMsg As String
    Dim MyLimit As Double


    NotSentMsg = "Not Sent"
    SentMsg = "Sent"
    
    MyLimit = 1
    
    Set FormulaRange = Me.Range("I2:I100")


    On Error GoTo EndMacro:
    For Each FormulaCell In FormulaRange.Cells
        With FormulaCell
            If IsNumeric(.Value) = False Then
                MyMsg = "Not numeric"
            Else
                If .Value > MyLimit Then
                    MyMsg = SentMsg
                    If .Offset(0, 1).Value = NotSentMsg Then
                        Call Mail_with_outlook2
                    End If
                Else
                    MyMsg = NotSentMsg
                End If
            End If
            Application.EnableEvents = False
            .Offset(0, 1).Value = MyMsg
            Application.EnableEvents = True
        End With
    Next FormulaCell


ExitMacro:
    Exit Sub


EndMacro:
    Application.EnableEvents = True


    MsgBox "Some Error occurred." _
         & vbLf & Err.Number _
         & vbLf & Err.Description


End Sub
Module 1

Code:
Public FormulaCell As Range


Sub Mail_with_outlook1()


    Dim OutApp As Object
    Dim OutMail As Object
    Dim strto As String, strcc As String, strbcc As String
    Dim strsub As String, strbody As String


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)


    strto = "****"
    strcc = ""
    strbcc = ""
    strsub = "Suspect Notification"
    strbody = ""


    With OutMail
        .To = strto
        .CC = strcc
        .BCC = strbcc
        .Subject = strsub
        .Body = strbody
        .Send
    End With


    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub


Sub Mail_with_outlook2()


    Dim OutApp As Object
    Dim OutMail As Object
    Dim strto As String, strcc As String, strbcc As String
    Dim strsub As String, strbody As String


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)


    strto = "****"
    strcc = ""
    strbcc = ""
    strsub = "Suspect Notification"
    strbody = ""


    With OutMail
        .To = strto
        .CC = strcc
        .BCC = strbcc
        .Subject = strsub
        .Body = strbody
        .Send
    End With


    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
Any Help would be great!!!
 
Last edited by a moderator:
Ran that code and changed C but nothing happenend... I changed to 2 j changed to sent but no email was sent....
 
Upvote 0

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Ran that code and changed C but nothing happenend... I changed to 2 j changed to sent but no email was sent....


Obviously something did happen or it wouldn't have changed to Sent.

Should this

Code:
                    If .Offset(0, 1).Value = NotSentMsg Then
                        Call Mail_with_outlook2
                    End If
be this?
Code:
                    If .Offset(0, 1).Value = [COLOR="#FF0000"]SentMsg[/COLOR] Then
                        Call Mail_with_outlook2
                    End If
As you are putting in a 2 which is greater than 1.
 
Last edited:
Upvote 0
Else
Code:
                If .Value > MyLimit Then
                    MyMsg = SentMsg

to

Code:
                If .Value > MyLimit Then
                    MyMsg = NotSentMsg

maybe.
 
Last edited:
Upvote 0
Like i say it works manually and everythings changing as it should just wont send automatically... I changes to 2 and J does change to sent it just doesnt send.... i cant see an issue with anything other than something in the mail code maybe...? Ive tried your suggestions but nothing seems to work :(
 
Upvote 0
Add this as shown
Code:
Sub Mail_with_outlook2()

[COLOR=#ff0000]    Stop[/COLOR]
    Dim OutApp As Object
    Dim OutMail As Object
When you change a value on the sheet, the VBE should open with that line highlighted. Does it?
 
Upvote 0
Code:
Private Sub Worksheet_Calculate()
    Dim FormulaRange As Range
    Dim NotSentMsg As String
    Dim MyMsg As String
    Dim SentMsg As String
    Dim MyLimit As Double
    NotSentMsg = "Not Sent"
    SentMsg = "Sent"
    MyLimit = 200
    Set FormulaRange = Me.Range("I2:I10")
    On Error GoTo EndMacro:
    For Each FormulaCell In FormulaRange.Cells
        With FormulaCell
            If IsNumeric(.Value) = False Then
                MyMsg = "Not numeric"
            Else
                If .Value > MyLimit Then
                    MyMsg = SentMsg
                    If .Offset(0, 1).Value = NotSentMsg Then
                        Call Mail_with_outlook1
                    End If
                Else
                    MyMsg = NotSentMsg
                End If
            End If
            Application.EnableEvents = False
            .Offset(0, 1).Value = MyMsg
            Application.EnableEvents = True
        End With
    Next FormulaCell
ExitMacro:
    Exit Sub
EndMacro:
    Application.EnableEvents = True
    MsgBox "Some Error occurred." _
         & vbLf & Err.Number _
         & vbLf & Err.Description
End Sub
Code:
Public FormulaCell As Range
Sub Mail_with_outlook1()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strto As String, strcc As String, strbcc As String
    Dim strsub As String, strbody As String
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    strto = "@outlook.com"
    strcc = ""
    strbcc = ""
    strsub = "outlook1"
    strbody = "outlook1"
    With OutMail
        .To = strto
        .CC = strcc
        .BCC = strbcc
        .Subject = strsub
        .Body = strbody
        .Send
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub


Sub Mail_with_outlook2()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strto As String, strcc As String, strbcc As String
    Dim strsub As String, strbody As String
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    strto = "@outlook.com"
    strcc = ""
    strbcc = ""
    strsub = "outlook2"
    strbody = "outlook2"
    With OutMail
        .To = strto
        .CC = strcc
        .BCC = strbcc
        .Subject = strsub
        .Body = strbody
        .Send
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

<strike></strike>

<strike></strike>
 
Last edited by a moderator:
Upvote 0
Hi, so the code is now working only problem is its sending all the previous cells that have changed to "Sent" as well, only need it to send the relevant cell that has just changed.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim FormulaRange As Range
    Dim NotSentMsg As String
    Dim MyMsg As String
    Dim SentMsg As String
    Dim MyLimit As Double


    NotSentMsg = "Not Sent"
    SentMsg = "Sent"
    
    MyLimit = 200
    
    Set FormulaRange = Me.Range("I2:I100")


    On Error GoTo EndMacro:
    For Each FormulaCell In FormulaRange.Cells
        With FormulaCell
            If IsNumeric(.Value) = False Then
                MyMsg = "Not numeric"
            Else
                If .Value > MyLimit Then
                    MyMsg = SentMsg
                    If .Offset(0, 1).Value = SentMsg Then
                        Call Mail_with_outlook2
                    End If
                Else
                    MyMsg = NotSentMsg
                End If
            End If
            Application.EnableEvents = False
            .Offset(0, 1).Value = MyMsg
            Application.EnableEvents = True
        End With
    Next FormulaCell


ExitMacro:
    Exit Sub


EndMacro:
    Application.EnableEvents = True


    MsgBox "Some Error occurred." _
         & vbLf & Err.Number _
         & vbLf & Err.Description


End Sub
Any ideas...?
 
Last edited by a moderator:
Upvote 0
Shouldn't this line
Code:
If .Offset(0, 1).Value = SentMsg Then
be
Code:
If .Offset(0, 1).Value = NotSentMsg Then
 
Upvote 0
I've changed that but that causes the email not to be sent... It is working just sending everything that says sent every time... Only need it to be sending one email as the individual cells change... :)
 
Upvote 0

Forum statistics

Threads
1,214,824
Messages
6,121,784
Members
449,049
Latest member
greyangel23

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top