Cell Flash on selection
Call the following code from Worksheet selection change event. This will highlight the cell for a second and then change back the color of the cell to its original.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call CellFlash(Target, 3487637)
End Sub
Sub CellFlash(ByVal Target As Range, Optional dblFlashColor As Double = 5287936)
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
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
- Vishesh's blog
- Login or register to post comments
- 4988 reads
ERROR IN CODE
WHILE RUNNING THE ABOVE CODE FOLLOWING ERROR SHOW :
RUN TIME ERROR "1004"
Application defined or object defined error
on pressing dubug tab
following line is highlighted
.color =dblflashcolor
sanjay agrawal
BARWAH (MP) INDIA.