PDA

View Full Version : Have Macro run when cell is updated



mduff
03-02-2014, 07:03 PM
Hi

I would like to know how to run this macro (or have a macro that gives the same results) every time a value is added to a any cell in Range("B44:TE44"). I have been playing with Private Sub Worksheet_Change but have not had much luck as if I hit enter it moves the active cell one way and if I hit Tab it moves it an other and it then changes my cell references for the offset same with Delete etc :banghead:.


Any Ideas


Macro I have


Sub newclass()
' adds a new class


Dim x As Double
Dim Y As Long
Dim Z As Long
x = ActiveCell.Value
Y = ActiveCell.Offset(-3, 0).Value
Z = ActiveCell.Offset(-2, 0).Value







ActiveCell.Offset(2, (Z - 1)).Value = (Y * x)


End Sub




What I have been playing with please note i have changed the offsets for it to work if I hit enter


Private Sub Worksheet_Change(ByVal Target As Range)


Dim X As Double
Dim Y As Long
Dim Z As Long




X = ActiveCell.Offset(-1, 0)
Y = ActiveCell.Offset(-4, 0).Value
Z = ActiveCell.Offset(-3, 0).Value


If Intersect(Target, Range("B44:TE44")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
' Application.EnableEvents = False

If Target.Value >= 0 Then




ActiveCell.Offset(1, (Z - 1)).Value = (Y * X)
'' Application.EnableEvents = True
End If


End Sub

thanks a lot in advance for your help!!!

mduff
03-02-2014, 09:13 PM
11359

I am attaching the file in case it helps the cells being impacted are in rows 41 to 46

thanks

Aflatoon
03-03-2014, 07:18 AM
The Target argument provided by Worksheet_Change is a reference to the cell (or cells) being changed, so you should use that rather than ActiveCell.

ryanrmbcap
03-03-2014, 08:08 AM
I'm having a similar issue. What I'm looking to do is have a userform pop-up when data is pasted into a worksheet. Right now when the userform pops up and the command button is clicked to run my first sub the userform keeps popping up, interrupting the first sub's progress. Here's the code that I'm using to get the userform to pop-up:

Private Sub Worksheet_Change(ByVal Target As Range)

If ActiveSheet.Range("A1") <> "" Then

UserForm1.Show

End If

End Sub



I also have the code : UserForm1.Hide as the first step within my first sub. Is there any suggestions on how I can make this work?

mduff
03-03-2014, 09:44 AM
Awesome that did it for me Maybe some one can help Ryanrmbcap with his issue

mduff
03-03-2014, 01:29 PM
Hi sorry to bring this back up but is there a way I can use this Worksheet_Change if multiple values are added to the range?

IE if a user copy and pastes values in it will trigger the "event" to run on all impacted cells?

thanks a lot

Aflatoon
03-04-2014, 09:33 AM
You need to loop:


Private Sub Worksheet_Change(ByVal Target As Range)

Dim rCell as Range
Dim X As Double
Dim Y As Long
Dim Z As Long

If Intersect(Target, Range("B44:TE44")) Is Nothing Then Exit Sub

Application.EnableEvents = False
for each rCell in Intersect(Target, Range("B44:TE44")).Cells
X = rCell.value
Y = rCell.Offset(-3, 0).Value
Z = rCell.Offset(-2, 0).Value

If rCell.Value >= 0 Then rCell.Offset(1, (Z - 1)).Value = (Y * X)
next rCell

Application.EnableEvents = True


End Sub

Aflatoon
03-04-2014, 09:35 AM
@ryanrmbcap

It would help to see the button routine, but I suspect you just need to add:

Application.EnableEvents = False
to the start of it and then

Application.EnableEvents = True
at the end.

mduff
03-04-2014, 07:59 PM
thanks a lot!!!!!!

mduff
03-04-2014, 08:26 PM
One last question to make this solution perfect I need to have it skip the cell (not run the Y*X) if Z has a null or 0 value I have tired adding the code in bold below but I get a "next with out for error"




Dim rCell As Range
''' Dim ccell As Range

Dim X As Double
Dim Y As Long
Dim Z As Long
''' ccell = Range("B5:TE5")
If Intersect(Target, Range("B7:TE7")) Is Nothing Then Exit Sub

Application.EnableEvents = False
For Each rCell In Intersect(Target, Range("B7:TE7")).Cells
X = rCell.Value
Y = rCell.Offset(-3, 0).Value
Z = rCell.Offset(-2, 0).Value
If Z = 0 Then Next rCell



ElseIf rCell.Value >= 0 Then rCell.Offset(2, (Z - 1)).Value = (Y * X)
Next rCell

Aflatoon
03-05-2014, 06:26 AM
Try this:

Dim rCell As Range
Dim X As Double
Dim Y As Long
Dim Z As Long

If Intersect(Target, Range("B7:TE7")) Is Nothing Then Exit Sub

Application.EnableEvents = False
For Each rCell In Intersect(Target, Range("B7:TE7")).Cells
X = rCell.Value
Y = rCell.Offset(-3, 0).Value
Z = rCell.Offset(-2, 0).Value
If Z <> 0 And rCell.Value >= 0 Then rCell.Offset(2, (Z - 1)).Value = (Y * X)
Next rCell

mduff
03-05-2014, 08:06 AM
you rock!!! !! thanks a lot!!!!

mduff
03-13-2014, 10:12 PM
I Really thought I had it but I found a few issues I tried to fix But i think i made it worse :(

The issues I have found is that if i remove a value in the target row it would not remove the value "this placed If Z <> 0 And rCell.Value >= 0 Then rCell.Offset(2, (Z - 1)).Value = (Y * X)"
Also if my multiple offsets that added values to the same cell it would not sum them but only add the last value.... so I have tried to fix it with the following code





Private Sub Worksheet_Change(ByVal Target As Range)
Dim allsites As Range
Dim Rcell As Range
Dim miRango As Range
Dim x As Double
Dim W As Double
Dim Y As Long
Dim Z As Long
'This adds the New hire classes and graduation rate %.
''If new sites are added then we need too add new named ragens for them and add them to the union below
Set allsites = Union(Range("SITE_1NH"), Range("SITE_2NH"), Range("SITE_3NH"), Range("SITE_4NH"), Range("SITE_5NH"), Range("SITE_6NH"), Range("SITE_7NH"))


If Intersect(Target, allsites) Is Nothing Then Exit Sub
'''


Application.EnableEvents = False
If Intersect(Target, Range("SITE_1NH")) Then
Set miRango = Range("SITE_1NH")
miRango.Offset(2, 0).ClearContents
ElseIf Intersect(Target, Range("SITE_2NH")) Then
Set miRango = Range("SITE_2NH")
miRango.Offset(2, 0).ClearContents
ElseIf Intersect(Target, Range("SITE_3NH")) Then
Set miRango = Range("SITE_3NH")
miRango.Offset(2, 0).ClearContents
ElseIf Intersect(Target, Range("SITE_4NH")) Then
Set miRango = Range("SITE_4NH")
miRango.Offset(2, 0).ClearContents
ElseIf Intersect(Target, Range("SITE_5NH")) Then
Set miRango = Range("SITE_5NH")
miRango.Offset(2, 0).ClearContents
ElseIf Intersect(Target, Range("SITE_6NH")) Then
Set miRango = Range("SITE_6NH")
miRango.Offset(2, 0).ClearContents
ElseIf Intersect(Target, Range("SITE_7NH")) Then
Set miRango = Range("SITE_7NH")
miRango.Offset(2, 0).ClearContents
End If


For Each Rcell In miRango.Cells
x = Rcell.Value
Y = Rcell.Offset(-3, 0).Value
Z = Rcell.Offset(-2, 0).Value
If Z <> 0 And x >= 0 Then
W = Rcell.Offset(2, (Z - 1)).Value
If W = 0 Then
Rcell.Offset(2, (Z - 1)).Value = (Y * x)
Else
Rcell.Offset(2, (Z - 1)).Value = W + (Y * x)
End If
End If
Next Rcell
Application.EnableEvents = True

It sort of works and fixes the issues I had with values not being removed BUT now I can not copy and paste or remove multiple ranges

Please let me know if you need more information or a sample book and thanks for your help :)

PS I changed the cell references for named ranges

Aflatoon
03-14-2014, 05:15 AM
I think a sample workbook would be very helpful, and please specify exactly what problems you have with it.