Blinking text

Question

Hi,

I need some help to find a code for blinking text.

I want that if text in cell A1 in sheet2 is the same as text appears in cell B23 in sheet1, text in cell A2 sheet2 starts blinking as "PASSED" in red.

Any help is appreciated.

Answer 1

I strongly urge you to rethink the blinking. Most people find it totally unsatisfactory. Why not use simple Conditional Formatting as shown in screenshot

best wishes

Answer 2

Hi QUCCA,

I need some help to find a code for blinking text.

I want that if text in cell A1 in sheet2 is the same as text appears in cell B23 in sheet1, text in cell A2 sheet2 starts blinking as "PASSED" in red.

Any help is appreciated. 

Try something like:

• Right-click the tab of the Sheet2
• Select the View Code option from the resultant context menu
• Paste the following event code:

'=========>>

Option Explicit

Private Sub Worksheet_Activate()

    Call CheckValue

End Sub

'--------->>

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim otherSH As Worksheet

    Dim Rng As Range, Rng2 As Range

    On Error Resume Next

    Set Rng = myCell.Precedents

    On Error GoTo 0

    If Not Rng Is Nothing Then

        Set Rng2 = Union(Rng, myCell)

    Else

        Set Rng2 = myCell

    End If

    If Not Intersect(Rng2, Target) Is Nothing Then

        If Rng2.Value = checkRng.Value Then

            Call StartTimer

            With Rng2.Offset(0, 1)

                .Font.ColorIndex = 3

                On Error GoTo XIT

                Application.EnableEvents = False

                .Value = "PASSED"

            End With

        Else

            Call StopTimer

            With Rng2.Offset(0, 1)

            .Value = vbNullString

            End With

        End If

    End If

XIT:

    Application.EnableEvents = True

End Sub

'--------->>

Private Sub Worksheet_Deactivate()

    Call CheckValue

End Sub

'<<=========

• Alt+F11 to open the VBA editor
• Alt+IM to insert a new code module
• In the new module, paste the following code

'=========>>

Option Explicit

Public Const aCell As String = "A1"                                  '<<=== Modify

Public Const bCell As String = "B23"                                '<<=== Modify

Public myCell As Range

Public checkRng As Range

Public RunWhen As Double

Public Const cRunIntervalSeconds = 1

Public Const cRunWhat = "Flash"

'--------->>

Public Sub StartTimer()

    Call StopTimer

    RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)

    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _

                       Schedule:=True

End Sub

'--------->>

Public Sub StopTimer()

    On Error Resume Next

    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _

                       Schedule:=False

End Sub

'--------->>

Public Sub Flash()

    With myCell.Offset(0, 1)

        .Font.ColorIndex = IIf(.Font.ColorIndex = xlAutomatic, 3, xlAutomatic)

    End With

    Call StartTimer

End Sub

'--------->>

Public Sub CheckValue()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim otherSH As Worksheet

    Set WB = ThisWorkbook

    With WB

        Set SH = WB.Sheets("Sheet2")            '<<=== Modify

        Set otherSH = .Sheets("Sheet1")         '<<=== Modify

    End With

    Set myCell = SH.Range(aCell)

    Set checkRng = otherSH.Range(bCell)

    If FlashValid(myCell) Then

        Call StartTimer

    Else

        myCell.Offset(0, 1).Interior.ColorIndex = xlNone

        Call StopTimer

    End If

End Sub

'--------->>

Public Function FlashValid(aRng As Range) As Boolean

    FlashValid = aRng.Value = checkRng.Value

End Function

'<<=========

• Ctrl+R to access the Project Explorer window
• Double-Click ThisWorkbook
• Paste the following code:

'=========>>

Option Explicit

'--------->>

Private Sub Workbook_Activate()

    Call CheckValue

End Sub

'--------->>

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Call StopTimer

End Sub

'--------->>

Private Sub Workbook_Deactivate()

    Call StopTimer

End Sub

'<<=========

• Alt+Q to close the VBA editor and return to Excel
• Save the file as a macro-enabled workbook with an xlsm extension

You may download my test fileQUCCA20160529.xlsm at

https://www.dropbox.com/s/shocg2c2w91bma9/QUCCA20160529.xlsm?dl=0

===

Regards,

Norman

Answer 3

Hi,

I do not recommend it but look here:

https://msdn.microsoft.com/en-us/library/office/ff193220.aspx

Answer 4

Bernard,

I fully agree.

Answer 5

Thanks a lot to all of you.