Forum Discussion

Lorenzo Kim's avatar
Lorenzo Kim
Bronze Contributor
Mar 23, 2018
Solved

blink a cell

in an excel sheet named "Form" - If B27 is blank, I would like G27 cell to blink and stop if B27 is not blank how would I write the vba macro? kindly make it simple - if possible somebody help ...
  • Jamil's avatar
    Mar 23, 2018

    Hello.

    If i recall correctly. I think i have answered similar question like this before.

    I think you may have difficulty on how to replicate the solution in your own file.

     

    I have recorded a video on how you can do it by yourself.

     

    This is the first part of the code that goes to a module

     

    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
    

     

    and this is the second part which goes to the Sheet Form object 

     

    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("B27")) Then
        Set rColumn = Range("B27")
       End If
    
    bCellCheck = False
    
    
       If Range("G27").Value = "" 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
    

Resources