izet99
09-29-2014, 04:25 PM
I found this code on this site, anybody know how would I modify this code to apply conditions a cross multiple columns... right now it highlight only cell containing data...
Right now it highlight cell that match criteria, however, I would like extent range of highlighted color as follow.
1. Data is in C column, for example if cell C16 = "Tom" or "Joe" highlighted range C16:K16
2. Also, if cell value in A(x) is < then $H$8, highlight range Cx:Kx, the same range as in above...
Basically I'm looking to highlight heading/section in a template across multiple worksheet.
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 "Tom", "Joe", "Paul"
Cell.Interior.ColorIndex = 3
Cell.Font.Bold = True
Case "Smith", "Jones"
Cell.Interior.ColorIndex = 4
Cell.Font.Bold = True
Case 10 To 25
Cell.Interior.ColorIndex = 6
Cell.Font.Bold = True
Case 26 To 99
Cell.Interior.ColorIndex = 7
Cell.Font.Bold = True
Case Else
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
End Select
Next
End Sub
Right now it highlight cell that match criteria, however, I would like extent range of highlighted color as follow.
1. Data is in C column, for example if cell C16 = "Tom" or "Joe" highlighted range C16:K16
2. Also, if cell value in A(x) is < then $H$8, highlight range Cx:Kx, the same range as in above...
Basically I'm looking to highlight heading/section in a template across multiple worksheet.
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 "Tom", "Joe", "Paul"
Cell.Interior.ColorIndex = 3
Cell.Font.Bold = True
Case "Smith", "Jones"
Cell.Interior.ColorIndex = 4
Cell.Font.Bold = True
Case 10 To 25
Cell.Interior.ColorIndex = 6
Cell.Font.Bold = True
Case 26 To 99
Cell.Interior.ColorIndex = 7
Cell.Font.Bold = True
Case Else
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
End Select
Next
End Sub