excel 2003 - vba - Worksheet_Change

[silentbuddha]

Hi,

How would i go about ensuring that "WorkSheet_Change" event handler only occurs when a user manually updates a cell and not when a cell change is done by another macro/subroutine ???

thanks !

 

[lenze]

In your other macro, disable events

Sub Foo()
Applcation.EnableEvents = False
'Your code
Application.EnableEvents = True
End Sub

lenze

 

[silentbuddha]

Hi Lenze,

Would you be able to assist me in figuring why these 3 subroutines are causing my macro to loop continuosly ?? Thank you !
********************** CODE **************************
Dim cellOldValue As Variant
Dim cellNewValue As Variant
Dim cellOldRange As Variant


********************** CODE **************************
Private Sub Worksheet_Change(ByVal Target As Range)
'This procedure will check whether the user made a change in specific cell
Dim interSectRange As Range
'set the range
Set interSectRange = Range("B16:B1430")
Application.EnableEvents = False

'Check whether active cell is within a specified range, if not then do nothing
If Intersect(Target, interSectRange) Is Nothing Then
' code to handle that the active cell is not within the right range
MsgBox "Active Cell not in Range!"
Application.EnableEvents = True
Exit Sub
Else
' code to handle when the active cell is within the right range
MsgBox "Active Cell In Range! Curent active cell is : " & ActiveCell.Address

Application.EnableEvents = True

'Exit Sub

End If

'Do nothing if more than one cell is changed or content deleted
If Target.Cells.count > 1 Or IsEmpty(Target) Then Exit Sub

'Ensure target cell value is a number
If IsNumeric(Target) Then
MsgBox "Value entered is a number!"
Application.EnableEvents = True
'Exit Sub
Else
MsgBox "value entered is not a number, please verify!"
Application.EnableEvents = True
Exit Sub
End If

'Check whether target cell address is valid before calling swapCells subroutine
If (Target.Row - Range("B16").Row) Mod 14 = 0 Then
MsgBox "The cell you have selected is allowed!"
cellNewValue = Target.Value
MsgBox " old value is " & cellOldValue
MsgBox " old cell address is " & cellOldRange
MsgBox " new value is " & cellNewValue
Application.EnableEvents = True
Call swapCellValue
Exit Sub

Else
MsgBox "the cell you have selected is not allowed!"
Application.EnableEvents = True
Exit Sub
End If
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'this code will store the old cell value before change is made by user
cellOldValue = ActiveCell.Value
cellOldRange = ActiveCell.Address

MsgBox " Worksheet_SelectionChange cellOldValue is : " & cellOldValue
MsgBox " Worksheet_SelectionChange cellOldRange is : " & cellOldRange
End Sub

Private Sub swapCellValue()

MsgBox " subroutine swapCellValue was called "
Dim c As Range
Dim kpiRange As Range
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook
Set ws = wb.Worksheets("Main")
Set kpiRange = ws.Range("B16:B1430")

For Each c In kpiRange
If (cellOldRange <> c.Address) And (cellNewValue = c.Value) Then
MsgBox " match found at " & c.Address & " with rank : " & c.Value
c.Value = cellOldValue

Set cellOldValue = Nothing
Set cellNewValue = Nothing
Set cellOldRange = Nothing

Exit Sub
End If
Next c
End Sub