PDA

View Full Version : Code change question



cmm0812
01-03-2008, 02:32 PM
I am using the code below (conditional formatting) and want to use it in a spreadsheet where the conditionally formatted cells reference other cells. Are there any suggestions as to how I can change this code to allow for that to happen?

Option Compare Text 'A=a, B=b, ... Z=z
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cell As Range
Dim Rng1 As Range

On Error Resume Next
Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1)
On Error GoTo 0
If Rng1 Is Nothing Then
Set Rng1 = Range(Target.Address)
Else
Set Rng1 = Union(Range(Target.Address), Rng1)
End If
For Each Cell In Rng1
Select Case Cell.Value
Case vbNullString
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
Case 2008
Cell.Interior.ColorIndex = 18
Cell.Font.Bold = True
Cell.Font.ColorIndex = 2
Case 2009
Cell.Interior.ColorIndex = 40
Cell.Font.Bold = True
Cell.Font.ColorIndex = 1
Case 2010
Cell.Interior.ColorIndex = 43
Cell.Font.Bold = True
Cell.Font.ColorIndex = 1
Case 2011
Cell.Interior.ColorIndex = 36
Cell.Font.Bold = True
Cell.Font.ColorIndex = 1
Case 2012
Cell.Interior.ColorIndex = 31
Cell.Font.Bold = True
Cell.Font.ColorIndex = 2
Case 2013
Cell.Interior.ColorIndex = 41
Cell.Font.Bold = True
Cell.Font.ColorIndex = 2
Case Else
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
End Select
Next

End Sub

Bob Phillips
01-03-2008, 02:51 PM
I am not sure what you are asking.

That code colours the cells depending on the value, so what more are you seeking?

cmm0812
01-03-2008, 03:11 PM
Yes, I am seeking to have the code colors change the cells, but the cells that I want changed are not changing when I do not type the value directly into the cells, but rather, have them referencing another workbook to obtain those values. I have attached an example.

Bob Phillips
01-03-2008, 03:30 PM
See if this works.

It goes in the workbook with the references to the formula, thoe one that you posted



Public WithEvents App As Application

Private Sub App_SheetCalculate(ByVal Sh As Object)
Dim Cell As Range
Dim Rng1 As Range

On Error Resume Next
Set Rng1 = Worksheets("Product").Cells.SpecialCells(xlCellTypeFormulas, 1)
On Error GoTo 0
If Not Rng1 Is Nothing Then
For Each Cell In Rng1
Select Case Cell.Value
Case vbNullString
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
Case 2008
Cell.Interior.ColorIndex = 18
Cell.Font.Bold = True
Cell.Font.ColorIndex = 2
Case 2009
Cell.Interior.ColorIndex = 40
Cell.Font.Bold = True
Cell.Font.ColorIndex = 1
Case 2010
Cell.Interior.ColorIndex = 43
Cell.Font.Bold = True
Cell.Font.ColorIndex = 1
Case 2011
Cell.Interior.ColorIndex = 36
Cell.Font.Bold = True
Cell.Font.ColorIndex = 1
Case 2012
Cell.Interior.ColorIndex = 31
Cell.Font.Bold = True
Cell.Font.ColorIndex = 2
Case 2013
Cell.Interior.ColorIndex = 41
Cell.Font.Bold = True
Cell.Font.ColorIndex = 2
Case Else
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
End Select
Next
End If
End Sub

Private Sub Workbook_Open()
Set App = Application
End Sub



This is workbook event code.
To input this code, right click on the Excel icon on the worksheet
(or next to the File menu if you maximise your workbooks),
select View Code from the menu, and paste the code

cmm0812
01-03-2008, 03:38 PM
No luck.

Bob Phillips
01-03-2008, 03:46 PM
Oh well! It worked for me, at least if I understood you correctly.