XLA routines: EE_CellFlash

Nick's picture
EE_CellFlash makes a cell colour flash
Sub EE_CellFlash(ByVal Target As range, Optional dblFlashColor As Double = 5287936)
'- takes a cell
'- changes the cell colour green for one second then back to original colour

    Dim dblColor                As Double
    Dim dblPattern              As Double
    Dim dblPatternColor         As Double
    Dim dblPatternColorIndex    As Double
    Dim dblThemeColor           As Double
    Dim dblTintAndShade         As Double
    Dim dblPatternTintAndShade  As Double
    Dim dblPatternThemeColor    As Double
    Dim dblChangeColor          As Double
 
'http://excelexperts.com/xla-routines-eeCellFlash    for updates on this sub routine

    With Target.Interior
        dblPattern = .Pattern
        dblColor = .Color
        dblPatternColorIndex = .PatternColorIndex
        dblPatternColor = .PatternColor
        dblThemeColor = .ThemeColor
        dblPatternThemeColor = .PatternThemeColor
        dblTintAndShade = .TintAndShade
        dblPatternTintAndShade = .PatternTintAndShade
    End With
 
    With Target.Interior
        If .Color = dblFlashColor Then
             .Color = dblFlashColor + 1000
        Else
            .Color = dblFlashColor
        End If
    End With
 
    Application.Wait (Now() + TimeValue("00:00:01"))
 
    With Target.Interior
        .Pattern = dblPattern
        .Color = dblColor
        .PatternColor = dblPatternColor
        .PatternColorIndex = dblPatternColorIndex
        On Error Resume Next
            .PatternThemeColor = dblPatternThemeColor
            .ThemeColor = dblThemeColor
        Err.Clear: On Error GoTo 0: On Error GoTo -1
        .TintAndShade = dblTintAndShade
        .PatternTintAndShade = dblPatternTintAndShade
    End With
End Sub