Detect when a Cell value has changed. Working too well :-(

C

CRayF

At the bottom, I have the entire module in case I’m missing something that
may be related but I’m missing… Otherwise...

In this module, when K1 cell is selected it returns the current worksheet
back to it’s default using a template. Once this routine runs I turn the
value of cell K1 to “defaultâ€. Now, when any Cell value is changed, I want to
turn the value of K1 to “Changedâ€. However right after I rebuild the
worksheet and set the value of K1 to "default", the value of K1 is
immediately being changed back to “Changedâ€. Could I be using the wrong
“Worksheet_Change†sub?
--------------------------

'------------------------------------------------------------------------
' [default/Changed!] Button - Re-Build Program Summary Template
'------------------------------------------------------------------------
If Target.Address = "$K$1" And ActiveSheet.Name <> _
srcProgramSummaryTemplateWs.Name Then
ReBuildProgramSummary True 'Runs rebuild with Prompt
Range("K1").Value = "default"
End If

--------------------------
Sub at the bottom of the page intended to change K1 to “Changed†when any
Cell value is modified. *********************
--------------------------
Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ws_exit:
Application.EnableEvents = False
Range("K1").Value = "Changed" '<---- 2 -----
ws_exit:
Application.EnableEvents = True
End Sub

--------------------------
Entire code ****************************
--------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim srcProgramDataInputWs As Worksheet
Dim srcProgramSummaryTemplateWs As Worksheet
Dim srcProgramSummaryWs As Worksheet
Dim srcBettingTemplateWs As Worksheet
Dim raceParkPrefix As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim wb As Workbook
Dim MyPath As String
Dim SaveDriveDir As String
Dim ImportRequested As String

Set srcProgramSummaryTemplateWs = Sheets("@TemplateProgramSummary")
Set srcProgramSummaryWs = Sheets("ProgramSummary")
Set srcBettingTemplateWs = Sheets("@TempleteBetting")
Set srcProgramDataInputWs = Sheets("ProgramDataInput")

raceParkPrefix = Left(srcProgramDataInputWs.Range("H3").Value, 3)

'------------------------------------------------------------------------
' [BET] Button - Create Bet Sheet
'------------------------------------------------------------------------
If Target.Address = "$A$1" And ActiveSheet.Name <> _
srcProgramSummaryTemplateWs.Name Then
Dim exists As Boolean
Dim ExistingBettingWsName As Worksheet
Dim NewBettingWsName As Variant

Range("N3").Select

NewBettingWsName = Format(srcProgramDataInputWs. _
Range("F3").Value, "mm-dd ") & _
Left(srcProgramDataInputWs.Range("H3").Value, 3)

exists = False
For Each ExistingBettingWsName In ThisWorkbook.Sheets
If ExistingBettingWsName.Name = NewBettingWsName Then
exists = True
Exit For
End If
Next
If exists Then
MsgBox "Betting Worksheet for [ " & NewBettingWsName & _
" ] already exists. [RENAME] or [DELETE] that Worksheet and try
again."

Else
If MsgBox("Create Race Betting Worksheet for [" &
NewBettingWsName & "]", _
vbYesNo) = vbYes Then
Dim NewBettingWs As Worksheet
Dim NewBettingWsTabColor As Variant
Dim raceParkPrefixList As Variant
Dim src As Variant

i = 6
raceParkPrefixList = srcProgramDataInputWs.Range("N" &
i).Value
Do Until raceParkPrefixList = ""
raceParkPrefixList = srcProgramDataInputWs.Range("N" &
i).Value
If raceParkPrefix = raceParkPrefixList Then
NewBettingWsTabColor = srcProgramDataInputWs.Range("O" & i).Value
i = i + 1
Loop
Range("N3").Select

srcBettingTemplateWs.Copy before:=ActiveSheet
Set NewBettingWs = ActiveSheet
With NewBettingWs
.Name = NewBettingWsName
.Unprotect
.Tab.ColorIndex = NewBettingWsTabColor 'or replace with
index number

src = srcProgramDataInputWs.Range("B3").Value
i = 3
j = 0
Do Until src = ""
srcBettingTemplateWs.Rows("11:22").Copy .Cells((j *
12) + 11, 1)
i = i + 12
j = j + 1
src = srcProgramDataInputWs.Cells(i, 2).Value
Loop

.Protect
End With
End If
End If
End If

'------------------------------------------------------------------------
' [default/Changed!] Button - Re-Build Program Summary Template
'------------------------------------------------------------------------
If Target.Address = "$K$1" And ActiveSheet.Name <> _
srcProgramSummaryTemplateWs.Name Then
ReBuildProgramSummary True
Range("K1").Value = "default" '<--- 1 -----
End If

'------------------------------------------------------------------------
' [IMPORT] Button - Import in different Race Track file
'------------------------------------------------------------------------
If Target.Address = "$B$1" And ActiveSheet.Name <> _
srcProgramSummaryTemplateWs.Name Then
Dim SelectedTxtInputFile As Variant
SaveDriveDir = CurDir
MyPath = ThisWorkbook.Path & "/RaceData-XLS-Ready"
ChDrive MyPath
ChDir MyPath

SelectedTxtInputFile = Application.GetOpenFilename( _
"Race Program Input Files (*.txt),*.txt", , _
"Select which RACE Program to import", , False)

If SelectedTxtInputFile = "False" Then
Range("N3").Select
Else
srcProgramDataInputWs.Unprotect
' srcProgramDataInputWs.Range("A3:H242").ClearContents
srcProgramDataInputWs.Range("A3:H900").ClearContents


With srcProgramDataInputWs.QueryTables.Add(Connection:= _
"TEXT;" & SelectedTxtInputFile _
, Destination:=srcProgramDataInputWs.Range("A3:H900"))
.Name = "ImportProgramData"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
srcProgramDataInputWs.Range("H2").Value = _
Format(srcProgramDataInputWs.Range("F3").Value, "mm-dd ") & _
Left(srcProgramDataInputWs.Range("H3").Value, 3)
srcProgramDataInputWs.Protect
ReBuildProgramSummary False 'call sub and turn off prompt
End If
ChDrive SaveDriveDir
ChDir SaveDriveDir
End If

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ws_exit:
Application.EnableEvents = False
Range("K1").Value = "Changed" '<---- 2 -----
ws_exit:
Application.EnableEvents = True
End Sub
 
R

Rowan

Maybe the Worksheet SelectionChange event is firing the worksheet change
event.

Add Application.enableevents = false
at the top and
Application.enableevents = true
back at the bottom with an error handler as you have done in the change
event.

Hope this helps
Rowan
At the bottom, I have the entire module in case I’m missing something that
may be related but I’m missing… Otherwise...

In this module, when K1 cell is selected it returns the current worksheet
back to it’s default using a template. Once this routine runs I turn the
value of cell K1 to “defaultâ€. Now, when any Cell value is changed, I want to
turn the value of K1 to “Changedâ€. However right after I rebuild the
worksheet and set the value of K1 to "default", the value of K1 is
immediately being changed back to “Changedâ€. Could I be using the wrong
“Worksheet_Change†sub?
--------------------------

'------------------------------------------------------------------------
' [default/Changed!] Button - Re-Build Program Summary Template
'------------------------------------------------------------------------
If Target.Address = "$K$1" And ActiveSheet.Name <> _
srcProgramSummaryTemplateWs.Name Then
ReBuildProgramSummary True 'Runs rebuild with Prompt
Range("K1").Value = "default"
End If

--------------------------
Sub at the bottom of the page intended to change K1 to “Changed†when any
Cell value is modified. *********************
--------------------------
Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ws_exit:
Application.EnableEvents = False
Range("K1").Value = "Changed" '<---- 2 -----
ws_exit:
Application.EnableEvents = True
End Sub

--------------------------
Entire code ****************************
--------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim srcProgramDataInputWs As Worksheet
Dim srcProgramSummaryTemplateWs As Worksheet
Dim srcProgramSummaryWs As Worksheet
Dim srcBettingTemplateWs As Worksheet
Dim raceParkPrefix As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim wb As Workbook
Dim MyPath As String
Dim SaveDriveDir As String
Dim ImportRequested As String

Set srcProgramSummaryTemplateWs = Sheets("@TemplateProgramSummary")
Set srcProgramSummaryWs = Sheets("ProgramSummary")
Set srcBettingTemplateWs = Sheets("@TempleteBetting")
Set srcProgramDataInputWs = Sheets("ProgramDataInput")

raceParkPrefix = Left(srcProgramDataInputWs.Range("H3").Value, 3)

'------------------------------------------------------------------------
' [BET] Button - Create Bet Sheet
'------------------------------------------------------------------------
If Target.Address = "$A$1" And ActiveSheet.Name <> _
srcProgramSummaryTemplateWs.Name Then
Dim exists As Boolean
Dim ExistingBettingWsName As Worksheet
Dim NewBettingWsName As Variant

Range("N3").Select

NewBettingWsName = Format(srcProgramDataInputWs. _
Range("F3").Value, "mm-dd ") & _
Left(srcProgramDataInputWs.Range("H3").Value, 3)

exists = False
For Each ExistingBettingWsName In ThisWorkbook.Sheets
If ExistingBettingWsName.Name = NewBettingWsName Then
exists = True
Exit For
End If
Next
If exists Then
MsgBox "Betting Worksheet for [ " & NewBettingWsName & _
" ] already exists. [RENAME] or [DELETE] that Worksheet and try
again."

Else
If MsgBox("Create Race Betting Worksheet for [" &
NewBettingWsName & "]", _
vbYesNo) = vbYes Then
Dim NewBettingWs As Worksheet
Dim NewBettingWsTabColor As Variant
Dim raceParkPrefixList As Variant
Dim src As Variant

i = 6
raceParkPrefixList = srcProgramDataInputWs.Range("N" &
i).Value
Do Until raceParkPrefixList = ""
raceParkPrefixList = srcProgramDataInputWs.Range("N" &
i).Value
If raceParkPrefix = raceParkPrefixList Then
NewBettingWsTabColor = srcProgramDataInputWs.Range("O" & i).Value
i = i + 1
Loop
Range("N3").Select

srcBettingTemplateWs.Copy before:=ActiveSheet
Set NewBettingWs = ActiveSheet
With NewBettingWs
.Name = NewBettingWsName
.Unprotect
.Tab.ColorIndex = NewBettingWsTabColor 'or replace with
index number

src = srcProgramDataInputWs.Range("B3").Value
i = 3
j = 0
Do Until src = ""
srcBettingTemplateWs.Rows("11:22").Copy .Cells((j *
12) + 11, 1)
i = i + 12
j = j + 1
src = srcProgramDataInputWs.Cells(i, 2).Value
Loop

.Protect
End With
End If
End If
End If

'------------------------------------------------------------------------
' [default/Changed!] Button - Re-Build Program Summary Template
'------------------------------------------------------------------------
If Target.Address = "$K$1" And ActiveSheet.Name <> _
srcProgramSummaryTemplateWs.Name Then
ReBuildProgramSummary True
Range("K1").Value = "default" '<--- 1 -----
End If

'------------------------------------------------------------------------
' [IMPORT] Button - Import in different Race Track file
'------------------------------------------------------------------------
If Target.Address = "$B$1" And ActiveSheet.Name <> _
srcProgramSummaryTemplateWs.Name Then
Dim SelectedTxtInputFile As Variant
SaveDriveDir = CurDir
MyPath = ThisWorkbook.Path & "/RaceData-XLS-Ready"
ChDrive MyPath
ChDir MyPath

SelectedTxtInputFile = Application.GetOpenFilename( _
"Race Program Input Files (*.txt),*.txt", , _
"Select which RACE Program to import", , False)

If SelectedTxtInputFile = "False" Then
Range("N3").Select
Else
srcProgramDataInputWs.Unprotect
' srcProgramDataInputWs.Range("A3:H242").ClearContents
srcProgramDataInputWs.Range("A3:H900").ClearContents


With srcProgramDataInputWs.QueryTables.Add(Connection:= _
"TEXT;" & SelectedTxtInputFile _
, Destination:=srcProgramDataInputWs.Range("A3:H900"))
.Name = "ImportProgramData"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
srcProgramDataInputWs.Range("H2").Value = _
Format(srcProgramDataInputWs.Range("F3").Value, "mm-dd ") & _
Left(srcProgramDataInputWs.Range("H3").Value, 3)
srcProgramDataInputWs.Protect
ReBuildProgramSummary False 'call sub and turn off prompt
End If
ChDrive SaveDriveDir
ChDir SaveDriveDir
End If

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ws_exit:
Application.EnableEvents = False
Range("K1").Value = "Changed" '<---- 2 -----
ws_exit:
Application.EnableEvents = True
End Sub
Click to expand...
 
C

CRayF

Well, I tried that and it didn't still get tripped. Is it possible one of the
xxx coded is triggering it? I checked and did not see any after going onto
this routing or anytime after the copy but… Is there a way to check only for
data changing in a cell and not cell movement. As a trigger?
 
R

Rowan

Hi

I removed everything that I thought was not relevant to this problem so
I was left with:
'----------------------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'<snip>
If Target.Address = "$K$1" Then
'ReBuildProgramSummary True
Target.Value = "default" '<--- 1 -----
End If
'<snip>
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ws_exit:
Application.EnableEvents = False
Range("K1").Value = "Changed" '<---- 2 -----
ws_exit:
Application.EnableEvents = True
End Sub
'-------------------------------------------------------------------------

With the SelectionChange and Change events implemented like above every
time K1 is selected it changes to "Default" and then immediately gets
changed again to "Changed". I then modified the code as follows:

'-------------------------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo ws_exit
Application.EnableEvents = False
'<snip>
If Target.Address = "$K$1" Then
'ReBuildProgramSummary True
Target.Value = "default" '<--- 1 -----
End If
'<snip>
ws_exit:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ws_exit:
Application.EnableEvents = False
Range("K1").Value = "Changed" '<---- 2 -----
ws_exit:
Application.EnableEvents = True
End Sub
'--------------------------------------------------------------------------

Now when I select cell K1 it takes on the value Default. When any cell
on the sheet is changed it takes on the value Changed.

The selection change event triggers everytime a new cell(s) is selected
on the sheet. The change event fires when a cell(s) has its value
changed. So what was happening is that the user would select K1. This
would fire the selectionchange event which would change the value of K1
to Default. The act of changing that value would trigger the change
event which in turn would change the value of K1 back to "Changed".
Setting enableevents as false in the selectionchange event prevents the
Change event from being triggered so that the value of K1 remains
"Default" until any cell on the sheet is changed.

Chip Pearson explains it a whole lot better than I ever could here:
http://www.cpearson.com/excel/events.htm

Hope this helps
Rowan
 
C

CRayF

Walla, perfect... thanks

Rowan said:
Hi

I removed everything that I thought was not relevant to this problem so
I was left with:
'----------------------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'<snip>
If Target.Address = "$K$1" Then
'ReBuildProgramSummary True
Target.Value = "default" '<--- 1 -----
End If
'<snip>
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ws_exit:
Application.EnableEvents = False
Range("K1").Value = "Changed" '<---- 2 -----
ws_exit:
Application.EnableEvents = True
End Sub
'-------------------------------------------------------------------------

With the SelectionChange and Change events implemented like above every
time K1 is selected it changes to "Default" and then immediately gets
changed again to "Changed". I then modified the code as follows:

'-------------------------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo ws_exit
Application.EnableEvents = False
'<snip>
If Target.Address = "$K$1" Then
'ReBuildProgramSummary True
Target.Value = "default" '<--- 1 -----
End If
'<snip>
ws_exit:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ws_exit:
Application.EnableEvents = False
Range("K1").Value = "Changed" '<---- 2 -----
ws_exit:
Application.EnableEvents = True
End Sub
'--------------------------------------------------------------------------

Now when I select cell K1 it takes on the value Default. When any cell
on the sheet is changed it takes on the value Changed.

The selection change event triggers everytime a new cell(s) is selected
on the sheet. The change event fires when a cell(s) has its value
changed. So what was happening is that the user would select K1. This
would fire the selectionchange event which would change the value of K1
to Default. The act of changing that value would trigger the change
event which in turn would change the value of K1 back to "Changed".
Setting enableevents as false in the selectionchange event prevents the
Change event from being triggered so that the value of K1 remains
"Default" until any cell on the sheet is changed.

Chip Pearson explains it a whole lot better than I ever could here:
http://www.cpearson.com/excel/events.htm

Hope this helps
Rowan
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Word macro that can call cells out of Excel for a find and replace 0
My variable always says False when I set it to True? 2
How to test Worksheet exists before trying to create it? 7
Macro to Select text from a point given to a specific word 2
VBA for Dependents shortcut menu 0
Find the correct sheet then find a value on that sheet 8
commandbutton does not answer 0
Some trouble assigning a string to a variable 22

Top