Popup if value in range is less than 5%

[cs8181]

I have a range of cells in row 39, with calculated percentages. If a change is made that makes any cell in the range fall below 5%, I would like a popup stating "Exceeded 5% Availability".

This is the VBA code I'm using so far with no result.

Private Sub Worksheet_Calculate()    If Range.("VA39:ZZ39") < 5 Then
        MsgBox "Busted 5% Availability"
    End If
End Sub

 

[Colo]

As an event driven, Change event runs when a value of cells are changed, but it doesn't run by the change from calculation. Instead of the Change event, Calculate event can be used like you tried but it's not handy as we expect. So I'd like to introduce you how to use the Change event for a changed value from calculation.

Important keyword this time is Dependency Property which displays the relationships between formulas and cells. If no relationships were found, it gives an error, so you need to put an error trap - "On Error Resume Next". And by using Intersect method, you can limit the range.

Here you are.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim myTarget As Range
    On Error Resume Next
        Set myTarget = Intersect(Target.Dependents, Me.Range("V39:ZZ39"))
    On Error GoTo 0
    
    If Not myTarget Is Nothing Then
        If myTarget.Value < 0.05 Then
            Application.Goto myTarget
            MsgBox "Busted 5% Availability", vbInformation, myTarget.Address
        End If
    End If
End Sub

Hope this helps.

 

[cs8181]

Seems to be working so far! Thank you.

 

[cs8181]

I am getting an error now and it is highlighting "If myTarget.Value < 0.05 Then". Not sure what that means.

 

[Colo]

About that part, I just guessed because I had no idea what kind of data and formulas are on the worksheet. So it needs to be fixed to suit to your worksheet.
Easy solution would be adding an error trap like

On Error Resure Next

 

[cs8181]

Do I put this at the end?

 

[Colo]

Ah okay, try like this.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim myTarget As Range
    On Error Resume Next
        Set myTarget = Intersect(Target.Dependents, Me.Range("V39:ZZ39"))
    On Error GoTo 0
    
    If Not myTarget Is Nothing Then
	On Error Resume Next
	        If myTarget.Value < 0.05 Then
	            Application.Goto myTarget
	            MsgBox "Busted 5% Availability", vbInformation, myTarget.Address
	        End If
	On Error GoTo 0
    End If
End Sub

 

[cs8181]

Seems to be giving the popup on every change. I double checked and I don't currently have any values under 5%

 

[Colo]

Okay, anyway the "calculate" event seems to be working. Remove the second On error resume next part then check why it gives you an error. The second IF part was written by my guess because I cannot see the worksheet or formulas, so you can amend it to suit your formula.

 

[mikerickson]

You could put Validation on 1:58 with the formula

=(COUNTIF($59:$59, "<.05")<>0)

The Alert could be either a Stop, a Warning or Info only.