Macro activating as result of formula

[gazclose]

I've been looking on forums for the last couple of days and could only get so far so here I am all signed up.

My goal is to automatically send an e-mail if a figure drops below zero.

I have got as far as knowing I need to set up a macro and that I need some code to activate the macro. I managed to get all the way to setting up the macro and put in some code to activate it, i typed in -15 and boom it worked, woooohoooo i thought, then I put the formula in tested it out and no it wouldn't work. Bit more research and it seems that if you need it to check the result of a formula rather than a manually entered figure it gets a lot more complicated. I tried the advice on various threads and there was loads of good stuff out there but my complete lack of understanding when it comes to Visual has me banging my head off a brick well.

So I'm hoping one of you fine people can help out.

The macro seems to be all find coding wise but I will add the code anyway.

Sub Mail_ActiveSheet()
'Working in Excel 2000-2016
'For Tips see: [URL]http://www.rondebruin.nl/win/winmail/Outlook/tips.htm[/URL]
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


    Set Sourcewb = ActiveWorkbook


    'Copy the ActiveSheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook


    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2016
            Select Case Sourcewb.FileFormat
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If .HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If
    End With


    '    'Change all cells in the worksheet to values if you want
    '    With Destwb.Sheets(1).UsedRange
    '        .Cells.Copy
    '        .Cells.PasteSpecial xlPasteValues
    '        .Cells(1).Select
    '    End With
    '    Application.CutCopyMode = False


    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & ""
    TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")


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


    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = "gazclose@blah.com"
            .CC = ""
            .BCC = ""
            .Subject = "Civil Engineering LAP exceeds capacity"
            .Body = "Please be advised the Civil Engineering group LAP has exceeded capacity, please review."
            .Attachments.Add Destwb.FullName
            'You can add other files also like this
            '.Attachments.Add ("C:\test.txt")
            .Send   'or use .Display
        End With
        On Error GoTo 0
        .Close savechanges:=False
    End With


    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr


    Set OutMail = Nothing
    Set OutApp = Nothing


    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

So that part works fine, its the next part that I am having trouble with.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If IsNumeric(Target) And Target.Address = "$D$15" Then
        Select Case Target.Value
        Case Is < 0: Mail_ActiveSheet
        End Select
    End If
End Sub

This simple wee guy works a treat but unfortunately if I have to manually input the figure the whole thing is pointless.

The formula I'm using in the cell couldn't be simpler. It's just "=sum(D14-D13)"

Thanks in advance.

 

[steve the fish]

Try using worksheet_calculate

 

[steve the fish]

Either that or you could do your change macro on D14 and D13 depending on if they are formula or not.

 

[frank_AL]

gazclose,

The Worksheet Change code is typically triggered when the user changes a specific cell. Since you have a formula in D15 it is not likely that the user is making changes to that cell. Also, since cells D14 and D13 may also be formula driven there could be several other cells that the user might change that would cause the values in D13/D14 to change and thus the result of the formula in D15 to change.

I recommend using Worksheet SelectionChange instead. This way, any change the user makes on that worksheet will trigger the code and the value of the formula in D15 will be evaluated and if <0 the Mail_Activesheet code module will be run.

Let me know if this works for you.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Range("D15").Value < 0 Then
        Call Mail_ActiveSheet
    End If
End Sub

The downside is that this code runs every time the user selects a different cell. If you know the specific cell/cells the user would be changing that would result in the value of D15 to change then you can use this code, simply change the Range in the "If Not Intersect(Target, Range(" line.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)


'   Check if Active Cell is D13 or D14 is Selected and Value of D15 changed to <0
If Not Intersect(Target, Range("D13:D14")) Is Nothing Then
    If Range("D15").Value < 0 Then
        Call Mail_ActiveSheet
    End If
End If


End Sub

 

[gazclose]

Frank, you are a super star. That worked perfectly!

 

[gazclose]

I may have been a little hasty... I was using the first one but yeah bit annoying every time you click plus i'm updating other tabs so unless you are on that sheet then it doesn't work

I tried the second example but to no success. I'm guessing the problem being its looking at the wrong thing and I'm not sure how to make it look at the correct tab.

If this helps the formula at D13 that refers to the part im interested in is "=SUM('Report 3 Import - For PSOs'!AL:AL)"

So the tab I'm after is "Report 3 Import - For PSOs" at the column is AL, I'm sure you got that but just to clarify. I tried to copy and paste that in to

If Not Intersect(Target, Range("D13:D14")) Is Nothing Then

But no joy. Sorry I am a complete amatuer

 

[gazclose]

Got the second one to work but I think its the same problem as we were having originally, the values of B13 & B14 are the result of a formula from a different tab

 

[frank_AL]

Okay, made some changes based on you last bit of shared information.

This code module needs to be placed on the Sheet "Report 3 Import - For PSOs"

You will need to modify the line of code that currently is: Set ws = Sheets("Name of Sheet") ' "where your D15 Cell you are Checking Exists"
You need to put the name of the Worksheet where the Cell D15 is that you want to evaluate so replace 'Name of Sheet' with whatever the correct Worksheet name is.
This code now looks for any 'user made' change in the AL column on the "Report 3 Import - For PSOs" Worksheet. Hopefully Column AL is not all formula driven as well!

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim ws As Worksheet
Set ws = Sheets("Name of Sheet")  '  "where your D15 Cell you are Checking Exists"


'   If cell in Col AL is changed on Worksheet "Report 3 Import - For PSOs" and Value of D15 changed to <0
If Target.Column = 38 Then
    If ws.Range("D15").Value < 0 Then
        Range("A1").Value = "Test"
'        Call Mail_ActiveSheet
    End If
End If


End Sub

 

[gazclose]

Ok getting there I think... i've added the module to the Report 3 tab as follows:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim ws As Worksheet
Set ws = Sheets("Sheet1") ' "where your D15 Cell you are Checking Exists"




' If cell in Col AL is changed on Worksheet "Report 3 Import - For PSOs" and Value of D15 changed to <0
If Target.Column = 38 Then
If ws.Range("D15").Value < 0 Then
Range("A1").Value = "Test"
' Call Mail_ActiveSheet
End If
End If




End Sub

It's just called Sheet1 at the moment where D15 is that we are looking at. The AL column is not the result of a formula you will be pleased to know However nothing is happening. It will execute in the VBA editor when I hit run but it also does when the conditions aren't correct eg when D15 > 0

Thanks again for all this help, its highly appreciated

 

[frank_AL]

Yes! Glad we found where values are manually input!

For test purposes I had the code entering the word "Test" in cell A1 just to verify it was properly evaluating Cell D15 on Sheet1 and I had commented out the Call Mail_Activate line of code. So here is the updated code and I have verified it in my test spreadsheet.

Are you familiar with how to put a stop on your code so you can step through it line by line? If so, put a stop on the line 'If Target.Column = 38 Then'. That way you will know for sure if the code is firing when a value in Column AL is changed and you can also verify the value in cell D15 to know if the call to Mail_Activate should be occurring.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim ws As Worksheet
Set ws = Sheets("Sheet1")


'   If cell in Col AL is changed on Worksheet "Report 3 Import - For PSOs" and Value of D15 changed to <0
If Target.Column = 38 Then
    If ws.Range("D15").Value < 0 Then
        Range("A1").Value = "Test"
'        Call Mail_ActiveSheet
    End If
End If


End Sub