PDA

View Full Version : Need help with macro to detect if cell value changes from current value



dave1414
05-03-2012, 06:03 PM
Hello all, I need help with an macro to notify me (by changing a cell background color to red), when the value (always number format) changes in any cells in the row. In the file I've uploaded, I want the background of cell E3 to change to red, if any of the values in cells F3:AN3 change from their current values. The numbers in cells F3:AN3 will be entered manually or thru copy and paste of the row, and there won't be any formulas. Likewise, if any values in cells F4:AN4 are changed, I would like cell E4 to change to a red background, and so on for each of the rows in the chart. Not all rows will always have a value, so I would be looking for changes from "" to any #, or from one # to another #, or from any # to "". Ideally this would be an event macro that does not have to be run manually.

The follwing is the code I've started working with:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F3:AN3")) Is Nothing Then KeyCellsChanged
End Sub

Private Sub KeyCellsChanged()

Dim Cell As Object
For Each Cell In Range("E3")
Cell.Interior.ColorIndex = 3

Next Cell
End Sub


However, this macro seems to run regardless of whether the number in the cell is changed, as long as I press enter it highlight E3 as red.

Any help is much appreciated!

Aussiebear
05-03-2012, 08:24 PM
You can try the following:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range
For Each Cel In Range("F3:AN3")
If Not Intersect(Target, Cel) Is Nothing Then
Cel.Interior.ColorIndex = 3
End If
Next Cel
End Sub

Bob Phillips
05-04-2012, 01:32 AM
I think this is what you want

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F3:AN20")) Is Nothing Then
If Target.Value <> "" Then
Me.Cells(Target.Row, "E").Interior.ColorIndex = 3
End If
End If
End Sub

Aussiebear
05-04-2012, 01:59 AM
I was sort of close.....

dave1414
05-04-2012, 07:11 AM
Wow that's great...you guys rock, thank you both.

There's just a slight problem I am having with the application. It works fantastic if all the values are entered by hand, follow by a hard return or tab. It also works if I use copy and paste value of a single cell.

However, if I copy a row of cells (from another doc) and try to paste it in, say the range (F3:AN3), I get a Run-time error 13 (type mismatch).

Any ideas on why I'm getting this and if I should use another Paste Special type to get around it or whether it requires different code?

Thanks!

Bob Phillips
05-04-2012, 07:56 AM
This should fix it, a mix of mine and the Bear's

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range

If Not Intersect(Target, Range("F3:AN20")) Is Nothing Then
For Each cell In Target
If cell.Value <> "" Then
Me.Cells(cell.Row, "E").Interior.ColorIndex = 3
End If
Next cell
End If
End Sub

dave1414
05-04-2012, 01:04 PM
Thanks xld....that definitely helps with the paste problem.

I'm really sorry to ask for more help, but I guess I didn't check the functionality correctly the first time. I just check by inputting different values into the cell and made sure the correct cell lit up red. However, I just discovered that when I enter the same value into the cell, it still highlights the corresponding cell in column E. For example, if the current value in the cell is 4 and I select the cell, enter 4, and press enter, it still highlights the cell in column E, even though no change has actually occurred to the value. I suspect it has something to do with the "If Not Intersect" as I remember having this problem yesterday when I was still working with my own code.

I really appreciate your help so far.

Bob Phillips
05-04-2012, 04:29 PM
Try this

Private prevValue As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range

If Not Intersect(Target, Range("F3:AN20")) Is Nothing Then
For Each cell In Target
Me.Cells(cell.Row, "E").Interior.ColorIndex = xlColorIndexNone
If cell.Value <> "" And cell.Value <> prevValue Then
Me.Cells(cell.Row, "E").Interior.ColorIndex = 3
End If
Next cell
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
prevValue = Target.Value
End Sub

Aussiebear
05-04-2012, 08:26 PM
However, I just discovered that when I enter the same value into the cell, it still highlights the corresponding cell in column E. For example, if the current value in the cell is 4 and I select the cell, enter 4, and press enter, it still highlights the cell in column E, even though no change has actually occurred to the value. I suspect it has something to do with the "If Not Intersect" as I remember having this problem yesterday when I was still working with my own code.

The sub is a Worksheet_Change event code, and is looking for any changes in the range F3:AN20. So even if it is the same vale you are entering, Excel regards it as a change to the initial value and hence the code will fire.

Teeroy
05-04-2012, 11:52 PM
If you want to check for changed values only you could copy the sheet as a hidden sheet at workbook open then test against these values at the worksheet_change event. Finally delete the copied sheet at workbook close.

dave1414
05-07-2012, 11:07 AM
Thanks Teeroy....I actually considered that option as well, but I thought it might slow the workbook down.

The last code posted by xld handles it very well. The only problem I can't seem to overcome is that well I enter a new value in one cell and try and fill right (ctrl+r) I get a run-time error 13 again. But other than that it works with hard returns, tabs, and copy and paste of sections.

Any ideas on the fill right problem?

Bob Phillips
05-07-2012, 02:29 PM
I can get it so that there is no error in that situation ... BUT ... the copied cells will not flag a change as the previous values get changed by the copy.

shrivallabha
05-08-2012, 08:59 AM
I have modified Bob's code a little which seems to handle horizontal series filling up.
Private prevValue As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range

If Not Intersect(Target, Range("F3:AN20")) Is Nothing Then

If Selection.Count > Target.Count And Selection.Row = Target.Row Then _
Cells(Selection.Row, "E").Interior.ColorIndex = 3: Exit Sub

For Each cell In Target
Me.Cells(cell.Row, "E").Interior.ColorIndex = xlColorIndexNone
If cell.Value <> "" And cell.Value <> prevValue Then
Me.Cells(cell.Row, "E").Interior.ColorIndex = 3
End If
Next cell
End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
prevValue = Target.Value
End Sub