Solved: Conditional Formatting: Copy Formats

[Ringhal]

Hi everyone

I will attempt to explain what I want in this post. I have also attached a file with a better explanation.

I have two tables in a worksheet. One table lists all the tasks and the "status" of the task. In another table, I have listed the "status" with special formatting. I would like to, with the help of the VBAX community, color the tasks (first table) using the formatting in the second table ("status").

As an example, in the status table, it shows if a task has a status of 1, the task will be colored red, so, if the task has a status of 1 it must be colored red.

In the attached sample file, I have 2 sheets, a "before" and an "after" one. In sheet2, that's how I want it to look after the formatting/coding is done. All values in the sheet could change. Columns A to G are occupied by other data, irrelevent to what we're working with.

[SamT]

Would this work for you? It uses Conditional formatting, so you can only set three formats, (in XL 2002, anyway.)

[Ringhal]

Thanks SamT

My intentions were to have many different task statuses. For example, 10% complete, 20% complete etc. all having different colorings. I found this code on VBAX, which I have partially adjusted to suit my needs, but it doesn't allow me to color an adjacent cell and I only need it to work on a specific range (Column H).

EDIT: It doesn't allow me to post links, so I will post the code instead:
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 1
Cell.Interior.ColorIndex = 3
Cell.Font.Bold = True
Case 2
Cell.Interior.ColorIndex = 6
Cell.Font.Bold = True
Case 3
Cell.Interior.ColorIndex = 4
Cell.Font.Bold = True
Case 99
Cell.Interior.ColorIndex = 1
Cell.Font.Bold = True
Cell.Font.ColorIndex = 2
Case Else
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
End Select
Next

End Sub

[SamT]

Option Explicit

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.Offset(0, 1).Value 'Offset(rows,cols) positive numbers offset (Down,Right)
Case vbNullString
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
Case 1
Cell.Interior.ColorIndex = 3
Cell.Font.Bold = True
Case 2
Cell.Interior.ColorIndex = 6
Cell.Font.Bold = True
Case 3
Cell.Interior.ColorIndex = 4
Cell.Font.Bold = True
Case 99
Cell.Interior.ColorIndex = 1
Cell.Font.Bold = True
Cell.Font.ColorIndex = 2
Case Else
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
End Select
Next

End Sub

[Ringhal]

Thanks SamT for the help