You description wan't very clearr but I asumed you want every cell to blink
together rather the one at a time. I create a UNION of cells and blinked the
union

Private Sub Worksheet_Calculate()
Dim newColor As Integer
Dim myCell As Range
Dim x As Integer
Dim fSpeed
Dim NuberGreaterThan As Integer
Dim BlinkRange As Range

LastRow = Range("A" & Rows.Count).End(xlUp).Row

''Create a union of cells to blink
First = True
For RowCount = 1 To LastRow
If Range("A" & RowCount) Range("B" & RowCount) Then
Range("A" & RowCount).Copy
Range("B" & RowCount).PasteSpecial _
Paste:=xlPasteValues
If First = True Then
Set BlinkRange = Range("G" & RowCount)
First = False
Else
Set BlinkRange = Application.Union(BlinkRange, Range("G" &
RowCount))
End If
End If
Next RowCount

'found at least pair of cells that was true
If First = False Then
Beep
newColor = 42
fSpeed = 0.4
Do Until x = 10
DoEvents
Start = Timer
Delay = Start + fSpeed

Do Until Timer Delay
DoEvents
BlinkRange.Interior.ColorIndex = newColor
Loop

Start = Timer
Delay = Start + fSpeed

Do Until Timer Delay
DoEvents
BlinkRange.Interior.ColorIndex = xlNone
Loop
x = x + 1
Loop
End If
End Sub





"sonicscooter" wrote:

Yesterday Joel was kind enough to help me by sending this as a better way of
writng what i had done, it works perfectly, but is there a way that i can use
it to access several ranges, ie instead of just using say A1:A10 B1:B10, by
making, For RowCount = 1 To 10, can i have BB1:A10 B1:B10
BC1:A10 C1:B10
BD:A10 D1:B10
Many thanks.

Private Sub Worksheet_Calculate()

Dim newColor As Integer
Dim myCell As Range
Dim x As Integer
Dim fSpeed

LastRow = Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 1 To LastRow

If Range("A" & RowCount) Range("B" & RowCount) Then
Beep
Range("A" & RowCount).Copy
Range("B" & RowCount).PasteSpecial _
Paste:=xlPasteValues

Set myCell = Range("G" & RowCount)
newColor = 42
fSpeed = 0.4
Do Until x = 10
DoEvents
Start = Timer
Delay = Start + fSpeed

Do Until Timer Delay
DoEvents
myCell.Interior.ColorIndex = newColor
Loop

Start = Timer
Delay = Start + fSpeed

Do Until Timer Delay
DoEvents
myCell.Interior.ColorIndex = xlNone
Loop
x = x + 1
Loop
End If
Next RowCount
End Sub