Consulting

Results 1 to 6 of 6

Thread: Code change question

  1. #1
    VBAX Regular
    Joined
    Dec 2007
    Posts
    23
    Location

    Code change question

    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

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    I am not sure what you are asking.

    That code colours the cells depending on the value, so what more are you seeking?
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    VBAX Regular
    Joined
    Dec 2007
    Posts
    23
    Location

    Explaination

    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.

  4. #4
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    See if this works.

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

    [vba]

    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
    [/vba]


    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
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  5. #5
    VBAX Regular
    Joined
    Dec 2007
    Posts
    23
    Location

    Reply

    No luck.

  6. #6
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    Oh well! It worked for me, at least if I understood you correctly.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •