Event Macro?

L

Lisa

I need help with a macro that will automatically run if
values in range D26:D29 have been added or changed.

Any help would be great,
Thanks
 
R

Ron de Bruin

Hi Lisa

You need a event

Read Chip Pearson's site about Events
http://www.cpearson.com/excel/events.htm

For example

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("D26:D29 "), Target) Is Nothing Then
MsgBox "You changed a cell in D26:D29 "
End If
End Sub
 
L

Lisa

Works nicely, but when I right click the range and clear
contents, the spreadsheet freezes up on me.

Is there anyway to prevent this?
-----Original Message-----
Hi Lisa

You need a event

Read Chip Pearson's site about Events
http://www.cpearson.com/excel/events.htm

For example

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("D26:D29 "), Target) Is Nothing Then
MsgBox "You changed a cell in D26:D29 "
End If
End Sub



--
Regards Ron de Bruin
http://www.rondebruin.nl


"Lisa" <[email protected]> wrote in
Click to expand...
message news:[email protected]...
 
R

Ron de Bruin

Yes

I forgot this first line
If Target.Cells.Count > 1 Then Exit Sub

It only run if you change one cell in the range
 
L

Lisa

Sorry, I forgot to add that this code will be calling
another macro. The following is the code that you gave me,
slightly modified a bit to call my macro, and the code
below that is the macro that is being called, what's weird
is that it works fine when using the worksheet change
macro for the pop up message, even when the cell is
cleared, but for some reason when I use it to call this
macro it works too, but freezes up when I right click a
cell and select clear contents.

Any more help would be greatly appreciated, Thanks

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("D26:D29 "),
Target) Is Nothing Then
Application.Run "'speedometer chart.xls'!
Chart_2049_Performance"
End If
End Sub



Sub Chart_2049_Performance()
Application.ScreenUpdating = False
Sheets("internal process perspective").Select
If Range("D26") = "" Then
Dim myChartObject As ChartObject
Dim myShape As Shape

With ActiveSheet
Set myChartObject = .ChartObjects("chart 2049")
For Each myShape In myChartObject.Chart.Shapes
If myShape.Type = msoPicture Then
'for testing:
'MsgBox myShape.Name
myShape.Delete
'just delete the first one found.
'exit for
End If
Next myShape
End With
ElseIf [D26] <> "" Then
Application.Run "'speedometer chart.xls'!macro3"
End If
If Range("D27") <> "" Then
Application.Run "'speedometer chart.xls'!macro4"
End If
If Range("D28") <> "" Then
Application.Run "'speedometer chart.xls'!macro5"
End If
If Range("D29") <> "" Then
Application.Run "'speedometer chart.xls'!macro6"
End If
End Sub

Sub macro3()
Application.ScreenUpdating = False
If Range("D26") > Range("D25") Then
Application.Run "'speedometer chart.xls'!
Delete_Airplane_Picture_Chart2049"
Application.Run "'speedometer chart.xls'!
Airplane_Up_Picture_On_Chart2049"
ElseIf Range("D26") < Range("D25") Then
Application.Run "'speedometer chart.xls'!
Delete_Airplane_Picture_Chart2049"
Application.Run "'speedometer chart.xls'!
Airplane_Down_Picture_On_Chart2049"
End If

End Sub
Sub macro4()
Application.ScreenUpdating = False
If Range("D27") > Range("D26") Then
Application.Run "'speedometer chart.xls'!
Delete_Airplane_Picture_Chart2049"
Application.Run "'speedometer chart.xls'!
Airplane_Up_Picture_On_Chart2049"
ElseIf [D27] < [D26] Then
Application.Run "'speedometer chart.xls'!
Delete_Airplane_Picture_Chart2049"
Application.Run "'speedometer chart.xls'!
Airplane_Down_Picture_On_Chart2049"
End If

End Sub

Sub macro5()
Application.ScreenUpdating = False
If Range("D28") > Range("D27") Then
Application.Run "'speedometer chart.xls'!
Delete_Airplane_Picture_Chart2049"
Application.Run "'speedometer chart.xls'!
Airplane_Up_Picture_On_Chart2049"
ElseIf [D28] < [D27] Then
Application.Run "'speedometer chart.xls'!
Delete_Airplane_Picture_Chart2049"
Application.Run "'speedometer chart.xls'!
Airplane_Down_Picture_On_Chart2049"
End If

End Sub
Sub macro6()
Application.ScreenUpdating = False
If Range("D29") > Range("D28") Then
Application.Run "'speedometer chart.xls'!
Delete_Airplane_Picture_Chart2049"
Application.Run "'speedometer chart.xls'!
Airplane_Up_Picture_On_Chart2049"
ElseIf [D29] < [D28] Then
Application.Run "'speedometer chart.xls'!
Delete_Airplane_Picture_Chart2049"
Application.Run "'speedometer chart.xls'!
Airplane_Down_Picture_On_Chart2049"
End If

End Sub

-----Original Message-----
Yes

I forgot this first line
If Target.Cells.Count > 1 Then Exit Sub

It only run if you change one cell in the range


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Lisa" <[email protected]> wrote in
Click to expand...
message news:[email protected]...
 
Top