Enum XlFlashStyle
xlFlashSameRow = 1
xlFlashSameColumn = 2
xlFlashAllUsedRange = 0
End Enum
Private Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Public RngFlash As Range, bTimerOn As Boolean
Sub Timer_On()
bTimerOn = True
SetTimer Application.hwnd, &O1010, 1000, AddressOf OnTimer
End Sub
Sub Timer_Off()
KillTimer Application.hwnd, &O1010
bTimerOn = False
End Sub
Sub OnTimer()
If RngFlash.Interior.ColorIndex = 3 Then
RngFlash.Interior.ColorIndex = xlNone
Else
RngFlash.Interior.ColorIndex = 3
End If
End Sub
Sub SetFlashRange(ByVal sRng As Range, Optional flashstyle As XlFlashStyle = xlFlashAllUsedRange)
Dim RngFindIn As Range
Set rngTmp = sRng
Select Case flashstyle
Case xlFlashSameRow
Set RngFindIn = sRng.Parent.Rows(sRng.Row)
Case xlFlashSameColumn
Set RngFindIn = sRng.Parent.Columns(sRng.Column)
Case xlFlashAllUsedRange
Set RngFindIn = sRng.Parent.UsedRange
End Select
With RngFindIn
Set c = .Find(sRng, , xlValues, xlWhole)
firstAddress = c.Address
Do
Set rngTmp = Union(rngTmp, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
Set RngFlash = rngTmp
End With
Set RngFindIn = Nothing
Call Timer_On
End Sub
Sub DisableLastFlashRange()
If bTimerOn = True Then
Call Timer_Off
If Not RngFlash Is Nothing Then RngFlash.Interior.ColorIndex = xlNone
End If
End Sub
Private Sub Worksheet_Deactivate()
Call DisableLastFlashRange
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngTmp As Range, c As Range
Call DisableLastFlashRange
If Target.Value = "" Or Target.Count > 1 Then Exit Sub
Call SetFlashRange(Target, xlFlashSameColumn)
End Sub