E
extremejobtvshow
VBA: Looking for a way to limit the range on this from the whole sheet
to several non-contigous ranges without slowing it way down. Any
suggestions would be greatly appreciated.
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 "1TR", "1PR", "1S1", "1S2"
Cell.Interior.ColorIndex = 37
Cell.Font.Bold = True
Cell.Font.ColorIndex = 1
Case "TR", "PR", "S1", "S2"
to several non-contigous ranges without slowing it way down. Any
suggestions would be greatly appreciated.
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 "1TR", "1PR", "1S1", "1S2"
Cell.Interior.ColorIndex = 37
Cell.Font.Bold = True
Cell.Font.ColorIndex = 1
Case "TR", "PR", "S1", "S2"