thedeadzeds
New member
- Joined
- Oct 25, 2011
- Messages
- 37
- Reaction score
- 0
- Points
- 0
- Excel Version(s)
- 2016
Hi All,
I've got this code which works great but It works for the whole spreadsheet. How to I adapt it to work for cells a13 to ho140
CHEERS
I've got this code which works great but It works for the whole spreadsheet. How to I adapt it to work for cells a13 to ho140
CHEERS
Code:
Option Compare Text 'A=a, B=b, ... Z=z
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If ActiveCell.Value = "Full Fail" Or ActiveCell.Value = "Sense Fail" Then
MsgBox "Please ensure you complete 3 full audits", vbInformation, "Complete the reason for Fail - Right click and insert comment"
End If
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 "Full Fail", "Sense Fail"
Cell.Interior.ColorIndex = 3
Cell.Font.Bold = True
Case "Sense in progress", "Full in progress"
Cell.Interior.ColorIndex = 6
Cell.Font.Bold = True
Case "Full Pass", "Sense Pass"
Cell.Interior.ColorIndex = 35
Cell.Font.Bold = True
Case Else
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
End Select
Next
End Sub
Last edited by a moderator: