Blinking cells in Excel and the OnTime function
On this page I show, how a macro can make one or more cells blink automatically, if the cell content doesn't meet a condition, and how the blink stops, if the cell value is changed to something okay.
The examples also show, how VBA's OnTime function can be used to "plan" execution of a procedure at a given time. The examples use Range variables.
It is not unlike conditional formatting, but conditional formatting cannot make cells blink - at least not in the old Excel versions I use.
Automatic execution of code
Every sheet in an Excel spreadsheet has a VBA code sheet, where you can put some standard procedures that are called automatically, if certain events happen on the sheet.
In the examples below we make use of the Worksheet_Change proceduren that executes automatically, when a cell or a range is changed in the sheet, and this also happens if the colour of a cell changes.
In the first example we make only one cell blink; in the other example it can be several cells in a range. You can download a spreadsheet with the example here. It is zipped, and you can unxip it by right-clicking and select "extract," or whatever Windows suggests.
Blinking cell
The following example will make cell C2 blink with a red colour, if the value changes to negative. Imagine that cell A2 represents your income, cell B2 your expenses and in C2 we deduct expenses from income. If the value becomes negative, the cell will blink with a red colour.
Open Excel's VBA editor (ALT+F11) and double click on one of the worksheets' code sheet. If you can't see them, you must open Project Explorer (CTRL+R). Highlight the following code with the mouse, copy (CTRL+C) and paste (CTRL+V) into the sheet's code sheet.
If you are viewing this page on a device with a small screen, some code lines may break/wrap, but if you copy and paste into the VBA editor, the linebreaks should be okay.
Option Explicit
Dim bCellCheck As Boolean
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo ErrorHandle
If Range("C2").Value < 0 And bCellCheck = False Then
Set rRange = Range("C2")
StartBlink
bCellCheck = True
ElseIf Range("C2").Value >= 0 And bCellCheck = True Then
Set rRange = Range("C2")
StopBlink
bCellCheck = False
End If
Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure Worksheet_Change."
Set rRange = Nothing
bCellCheck = False
End Sub
Now you must insert a VBA module (menu "Insert" and "Module") and insert the following code:
Option Explicit
Public rRange As Range
Dim dNextTime As Double
Sub StartBlink()
On Error GoTo ErrorHandle
With rRange.Interior
If .ColorIndex = 3 Then
.ColorIndex = xlNone
Else
.ColorIndex = 3
End If
End With
dNextTime = Now + TimeSerial(0, 0, 1)
Application.OnTime dNextTime, "StartBlink", , True
Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure StartBlink."
Set rRange = Nothing
End Sub
Sub StopBlink()
On Error GoTo ErrorHandle
rRange.Interior.ColorIndex = xlNone
Application.OnTime dNextTime, "StartBlink", , False
BeforeExit:
Set rRange = Nothing
Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure StopBlink."
Resume BeforeExit
End Sub
That was it. Cell C2 will now blink red, if there is a change that makes the value negative, and the blink will stop, if the value becomes zero or higher.
More blinking cells
The following example shows how to make more cells in a range blink, if they get negative values (or ...). Again it could be income in column A, expenses in column B and the balance (income minus expenses) in column C starting in cell C2. If something changes making a value not negative, the cell will stop blinking.
The code in the standard module must be like above, but the code on the sheet's code sheet must be changed as follows.
Option Explicit
Dim bCellCheck As Boolean
Dim bBlink As Boolean
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rColumn As Range
Dim rCell As Range
Dim sAdress As String
On Error GoTo ErrorHandle
Set rColumn = Range("C2")
If Not IsEmpty(Range("C3")) Then
Set rColumn = Range(rColumn, rColumn.End(xlDown))
End If
bCellCheck = False
For Each rCell In rColumn
If rCell.Value < 0 Then
bCellCheck = True
If Len(sAdress) > 0 Then
sAdress = sAdress & "," & rCell.Address
Else
sAdress = sAdress & rCell.Address
End If
End If
Next
If bCellCheck = True And bBlink = False Then
Set rRange = Range(sAdress)
bBlink = True
StartBlink
ElseIf bCellCheck = True And bBlink = True Then
Set rRange = rColumn
StopBlink
Set rRange = Range(sAdress)
StartBlink
ElseIf bCellCheck = False And bBlink = True Then
Set rRange = rColumn
StopBlink
bBlink = False
End If
Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure Worksheet_Change."
Set rRange = Nothing
Set rColumn = Nothing
Set rCell = Nothing
bCellCheck = False
End Sub
That was it. When the cells are blinking, you can insert new values, but you cannot copy cells, unless you can do it in less than 1 second! If blinking cells can be used for anything is quite another matter, but it shows some the power of VBA.
Related:
|