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:
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..
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
Related
I have a simple code that should call an Userform (CorrectiveActions) when the user inputs a value greater than 2.5 in certain cells.
Private Sub Worksheet_Change(ByVal target As Range)
If target.Count > 1 Then Exit Sub
If Not Application.Intersect(target, Me.Range("F11:F1292,K11:K1292,P11:P1292")) Is Nothing Then
If target >= 2.5 And IsNumeric(target) And Intersect(target, Me.Range("K11:K1292")) Is Nothing Or target.Offset(0, 1) >= 2.5 And Intersect(target, Me.Range("F11:F1292,P11:P1292")) Is Nothing Then CorrectiveActions.Show
End If
End Sub
The userform contains a listbox and I want to fill the cell below the one where the value greater than 2.5 is. I used the following code:
Private Sub ListBox1_Click()
Dim cellRow As Integer
Dim cellCol As Integer
cellRow = ActiveCell.Row
cellCol = ActiveCell.Column
Cells(cellRow, cellCol).Offset(1, 0).Value = ListBox1
End Sub
This Userform works fine when I launch it manually. However, when I input a value greater than 2.5 in the specified cell, the Userform shows up, but won't work. That is, the cell won't get filled.
I would like to do a macro. My testing cells are on another sheet. Sheet - (data) Macro check a range ("D2:D10") if the cells contain value 12 if yes show me a message box "Go to add to system" and this cell where macro found a value will be set to 0.
I have this code but it doesn't work for me I don't known why. Can you help me?
Private Sub check(ByVal Target As Range)
For Each c In Worksheet("data").Range("D2:D10")
If Range("D2:D10") = 12 Then
MsgBox "Go to add to system"
Range ("D2:D10").value = 0
End If
Next c
End Sub
The code below will correct your code (it will run without errors):
Option Explicit
Private Sub check(ByVal Target As Range)
Dim c As Range
For Each c In Worksheets("data").Range("D2:D10")
If c.Value = 12 Then
MsgBox "Go to add to system"
c.Value = 0
End If
Next c
End Sub
However, you could go with a slightly different approach - by accomplishing what you are trying to achieve in the Worksheet_Change event (of "data" sheet).
Code
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
' Optional : use if criteria below to check the range only
' if one of the cells inside range("D2:D10") has changed
If Not Intersect(Range("D2:D10"), Target) Is Nothing Then
' if you decide to use the "If"above, then you don't need the "For" loop below
For Each c In Range("D2:D10")
If c.Value = 12 Then
MsgBox "Go to add to system"
c.Value = 0
End If
Next c
End If
End Sub
As per subject, what I need is to run macro based on other cells.
Here is the case :
cells G3 until the end of row contains data used formula =IF(B3="";"";(SUMIF('Incoming Goods'!$F$3:$F$1048576;'Current Stock'!B3;'Incoming Goods'!$M$3:$M$1048576)-(SUMIF('Outgoing Goods'!$D$4:$D$1048576;'Current Stock'!B3;'Outgoing Goods'!$J$4:$J$1048576))))--> i need to convert this formula to VBA
cells H3 should contain : If G3.value = 0 then "Out of Stock", else " "
And this sheet must be calculate every time data in G3 change automatically or any additional data on this sheet.
Already tried this code :
Private Sub Worksheet_Calculate()
Dim Current As Worksheet
Dim Rng1 As Range
Dim Target As Range
Set Current = Worksheets("Current Stock")
Set Rng1 = Current.Range("G:G")
Set Target = Range("H:H")
For Each Rng1 In Target
If Rng1.Value2 = "0" Then
Target.Value2 = "Out Of Stock"
Else
Exit Sub
End If
Next
End Sub
However, above code is Not working. Already try using Private Sub Selection Change() and Private Sub Selection Change() but still not working.
Any suggestion?
Thanks in advance
the answer to the first part is below:
ActiveCell.FormulaR1C1 = _
"=IF(R[2]C[1]="""","""",(SUMIF('Incoming Goods'!R3C6:R1048576C6,'Current Stock'!R[2]C[1],'Incoming Goods'!R3C13:R1048576C13)-(SUMIF('Outgoing Goods'!R4C4:R1048576C4,'Current Stock'!R[2]C[1],'Outgoing Goods'!R4C10:R1048576C10))))"
handy tip: to convert any excel formula to code, hit the record macro button, then click on the cell, press F2 key, then press enter, and stop recording macro. The code will now be in its own module in the vba editor.
This should do what you want.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("A1"), Target) Is Nothing Then
If IsNumeric(Target.Value) And Target.Value > 200 Then
Call YourMacroName
End If
End If
End Sub
I need some help with this code as it doesn't work properly.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
For Each Cell In Target
With Cell
If .Column = Range("W:W").Column Then
Cells(.Row, "AC").Value = Int(Now)
End If
End With
Next Cell
End Sub
I am trying to get automatic static date stamps in column "AC" every time I fill in cells in column "W" and I want to start with row "19".
Tried to use
If .Column = Range("W19").End(xldown) Then
but it doesn't work.
I've just started using macro and vba and it will really help me if you can explain any solutions to me.
Thank you
Always turn off events if you are going to write to the worksheet in order that the Worksheet_Change event macro does not try to run on top of itself.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("W:W")) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
Dim rng As Range
For Each rng In Intersect(Target, Columns("W:W"))
If rng.Row > 18 Then _
rng.Offset(0, 6) = Date 'or Now for datetime
Next rng
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
This should handle multiple changes to column W like a block range paste.
In Excel 2007 I want to prompt a message when a cell (L2) is clicked on. I have a piece of code that works but the problem is that when I select all the cells in the sheet with Ctrl+A I get error number 06: overflow on the line If Selection.Count = 1 Then
Mandatory VBA code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
If Not Intersect(Target, Range("L2")) Is Nothing Then
MsgBox "ACTION!"
End If
End If
End Sub
Easily fixed:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.CountLarge = 1 Then
If Not Intersect(Target, Range("L2")) Is Nothing Then
MsgBox "ACTION!"
End If
End If
End Sub
Try this:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If InStr(1, CStr(Target.Address), ":") < 1 Then
If Selection.Count = 1 Then
If Not Intersect(Target, Range("L2")) Is Nothing Then
MsgBox "ACTION!"
End If
End If
End If
End Sub
You must change your code as follows. No Error-Traps needed:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Area.Count = 1 Then
If Not Intersect(Target, Range("L2")) Is Nothing Then
MsgBox "ACTION!"
End If
End If
End Sub
If you had 64-bit Excel I would tell you to use CountLarge instead of Count. Excel 2007 only comes in the 32-bit variety so that's not an option for you.
Your problem is that Range.Count returns a Long variable and throws an error if the number of cells is greater than a Long can store.
To get around this, you can do the following:
Use a Decimal data type stored inside a Variant. The combination can count more than the 1,048,576 rows x 16,384 columns of cells in an Excel worksheet.
Count the cells one column at a time to avoid the error with Range.Count.
I wrote a function that does that. Save this function in a regular code module (not a Worksheet or Workbook module) and use it like this:
If CountLarge32(Selection) = 1 Then
Here's the actual function:
Public Function CountLarge32(ByVal rangeOrSelection As Variant) As Variant
Dim target As Excel.Range
On Error Resume Next
Set target = rangeOrSelection
On Error GoTo 0
Dim cnt As Variant
Dim iColumn As Excel.Range
If Not target Is Nothing Then ' parameter -IS- a valid Range
' Use Range.Count on one column at a time to avoid the overflow error
' if counting higher than the limit of the Long data type.
For Each iColumn In target.Columns
cnt = CDec(cnt + iColumn.Cells.Count)
Next iColumn
CountLarge32 = cnt
End If
End Function
This function also avoids the error that occurs if Select is an object (e.g. button, shape, chart, etc.) instead of a cell.