Tags: case, cell, detect, entire, excel, iacirc, microsoft, missing, missingacircbrvbar, module, msdn, related, software, value, working

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

On Microsoft » Microsoft Excel

21,246 words with 4 Comments; publish: Fri, 23 May 2008 04:30:00 GMT; (30693.75, « »)

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(".excel.questionfor.info.TemplateProgramSummary")

Set srcProgramSummaryWs = Sheets("ProgramSummary")

Set srcBettingTemplateWs = Sheets(".excel.questionfor.info.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

All Comments

Leave a comment...

  • 4 Comments
    • 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

      CRayF wrote:

      > 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(".excel.questionfor.info.TemplateProgramSummary")

      > Set srcProgramSummaryWs = Sheets("ProgramSummary")

      > Set srcBettingTemplateWs = Sheets(".excel.questionfor.info.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

      #1; Fri, 23 May 2008 04:31:00 GMT
    • 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?

      #2; Fri, 23 May 2008 04:32:00 GMT
    • 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

      CRayF wrote:

      > 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?

      #3; Fri, 23 May 2008 04:33:00 GMT
    • Walla, perfect... thanks

      "Rowan" wrote:

      > 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

      > CRayF wrote:

      > > 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?

      >

      #4; Fri, 23 May 2008 04:34:00 GMT