Code:
Option Explicit
Option Base 1
Dim nextTick
Private Sub Workbook_Open()
Call ThisWorkbook.prTurnOn
End Sub
Private Sub Workbook_Close()
Call ThisWorkbook.prTurnOff
End Sub
Sub prTurnOn()
nextTick = Now + TimeValue("00:00:01")
Application.OnTime nextTick, "ThisWorkbook.prVBACondFormat"
End Sub
Sub prTurnOff()
Application.OnTime nextTick, "ThisWorkbook.prVBACondFormat", , False
End Sub
Sub prVBACondFormat()
Dim arrChecks() As Variant
Dim arrTemp() As Variant
Dim numChecks As Long
Dim ws As Worksheet
Dim rngFull As Range
Dim rngC As Range
Dim operator As String
Dim val As String
Dim tempVal As String
Dim RGBCol As Long
Dim boolFlash As Boolean
Dim ubArrC As Long
Dim lbArrC As Long
'------------------------------------------------------
'Start of User Settings // Change the below to be equal to your settings
'------------------------------------------------------
'Set the number of checks that you need
numChecks = 5
'--------------------------------
'DO NOT CHANGE
ReDim arrChecks(1 To numChecks)
'--------------------------------
'Set each of the values below to the conditions you want to check
'In the format:
'Array( [Cell address], [operator], [value to check], [RGB Colour], [boolFlash] )
'Where:
'[Cell address], String, "$A$1"
'[operator], String, "=", ">", "<=" etc
'[value to check], String/Numerical, "Stuff", 5
'[RGB Colour], Numerical, RGB(255, 0, 0) = Red
'[boolFlash], Boolean (True/False), True = Flash cell, False = Constant cell colour
arrChecks(1) = Array("$H$12", "=", "stuff", RGB(255, 0, 0), True)
arrChecks(2) = Array("$B$5", ">", 5, RGB(0, 255, 0), True)
arrChecks(3) = Array("$A$4, $A$7, $A$10", ">=", 5, RGB(0, 0, 255), False)
arrChecks(4) = Array("$C$1:$C$7", "=", "ThisString", RGB(0, 255, 0), False)
arrChecks(5) = Array("$D$1:$D$4", "<=", 10, RGB(204, 255, 180), True)
'Change to the worksheet you want the code to run for.
Set ws = ThisWorkbook.Worksheets("Sheet1")
'------------------------------------------------------
'End of User Settings // Do not change the following code
'------------------------------------------------------
lbArrC = LBound(arrChecks, 1)
ubArrC = UBound(arrChecks, 1)
Dim i As Long
For i = lbArrC To ubArrC
arrTemp = arrChecks(i)
Set rngFull = ws.Range(arrTemp(1))
operator = arrTemp(2)
val = arrTemp(3)
tempVal = val
RGBCol = arrTemp(4)
boolFlash = arrTemp(5)
For Each rngC In rngFull.Cells
val = tempVal
With rngC.Interior
If ThisWorkbook.fnEvalCell(rngC, operator, val) Then
If boolFlash = True Then
If .Color = RGBCol Then
.Pattern = xlNone
Else
.Pattern = xlSolid
.Color = RGBCol
End If
Else
.Pattern = xlSolid
.Color = RGBCol
End If
Else
.Pattern = xlNone
End If
End With
Next rngC
Next i
nextTick = Now + TimeValue("00:00:01")
Application.OnTime nextTick, "ThisWorkbook.prVBACondFormat"
End Sub
Function fnEvalCell(rng As Range, operator As String, val As String) As Boolean
If Not IsNumeric(val) Then
val = """" & val & """"
End If
fnEvalCell = Evaluate("IF(" & rng.Address & operator & val & ", TRUE, FALSE)")
End Function
I want a range of cells to flash if H12 says "stuff" (I want to change the name to stuff to whatever I want). All I get is "subscript out of range"