CODEWITHSUNDEEP
vbaexcel
Red Eye
Red Eye

Reputation: 37

VBA Alert pop up for values in a column

I'm trying to create a VBA -Alert pop up in a excel column. In the excel sheet based on certain calculation some Growth% (column H) will be calculated and if the Growth% > 20%, a alert popup would be generated asking for the Reason Code, which needs to be put in Column I. The code is working fine for a particular cell (say H7) but when I'm extending it for a range (say H7:H700), it's not working. Can someone please assist me regarding this. The code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("H7:H700") > 0.2 Then
        MsgBox "GR% >20%, Put the reason code"
    End If
End Sub

% growth Reason Code 34% 20% 18%

The updated snapshot of the excel sheet:enter image description here

Now the ASM/RSM can update their forecast and automatically Growth % will be calculated in column H ...the same values will be copied in column I (as paste special) and if the Growth % > 20% , then the alert will pop up...

The code I'm using ( with kind help of JC Guidicelli):

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xCell As Range, Rg As Range
On Error Resume Next
 Sheets("Sheet1").Range("H7:H700").Copy
 Sheets("Sheet1").Range("I7:I700").PasteSpecial xlPasteValues
Set Rg = Application.Intersect(Target, Range("I7:I700"))
If Not Rg Is Nothing Then
    For Each xCell In Rg
        If xCell.Value > 0.2 Then
            xCell.Select
            MsgBox "GR% >20%, Put the reason code"
            Exit Sub
        End If
    Next
End If

End Sub

The issue is for the calculation of Growth% < 20% , it's working fine...but for Growth% >20%, it's throwing the pop up but getting stuck.. Could someone please assist me regarding this..

Upvotes: 3

Views: 1137

Answers (1)

JC Guidicelli
JC Guidicelli

Reputation: 1316

EDIT: When you add or paste value in your selected range, the message is showing ;) Try and let me know, it's working for me :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xCell As Range, Rg As Range
    On Error Resume Next
    Set Rg = Application.Intersect(Target, Range("H7:H700"))
    If Not Rg Is Nothing Then
        For Each xCell In Rg
            If xCell.Value > 0.2 Then
                xCell.Select
                MsgBox "GR% >20%, Put the reason code"
                Exit Sub
            End If
        Next
    End If
End Sub

Upvotes: 1

Related Questions