allthingstec
05-04-2018, 03:02 PM
Can someone add to this code so the cell will only blink a set number of times?
Thanks???
Option Explicit
Dim bCellCheck As Boolean
Dim bBlink As Boolean
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rColumn As Range
Dim sAdress As String
On Error GoTo ErrorHandle
If Not IsEmpty(Range("G4")) Then
Set rColumn = Range("G4")
End If
bCellCheck = False
If Range("I5").Value < (8) Then
bCellCheck = True
If Len(sAdress) > 0 Then
sAdress = sAdress & "," & rColumn.Address
Else
sAdress = sAdress & rColumn.Address
End If
End If
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
bCellCheck = False
End Sub
Thanks???
Option Explicit
Dim bCellCheck As Boolean
Dim bBlink As Boolean
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rColumn As Range
Dim sAdress As String
On Error GoTo ErrorHandle
If Not IsEmpty(Range("G4")) Then
Set rColumn = Range("G4")
End If
bCellCheck = False
If Range("I5").Value < (8) Then
bCellCheck = True
If Len(sAdress) > 0 Then
sAdress = sAdress & "," & rColumn.Address
Else
sAdress = sAdress & rColumn.Address
End If
End If
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
bCellCheck = False
End Sub