ExcelBanter - Help to find a code

Here is a novelty procedure that I wrote. Maybe you can use it to develop
something:
The delay function is called by the ColrRng procedure.

Sub ColrRng() 'Displays different colors in four quadrants
Worksheets(2).Cells.Clear
Worksheets(2).Rows.UseStandardHeight = True
Set Rng1 = Range("$A$1:$I$18")
Set Rng2 = Range("$J$1:$U$18")
Set Rng3 = Range("$A$19:$I$45")
Set Rng4 = Range("$J$19:$U$45")
Rng1.BorderAround ColorIndex:=2, Weight:=xlMedium
Rng2.BorderAround ColorIndex:=2, Weight:=xlMedium
Rng3.BorderAround ColorIndex:=2, Weight:=xlMedium
Rng4.BorderAround ColorIndex:=2, Weight:=xlMedium
counter = 1
Do
If counter = 1 Then
Set newWordArt = Worksheets(2).Shapes. _
AddTextEffect (PresetTextEffect:=msoTextEffect3, _
Text:="WATCH THIS", FontName:="Ravie", FontSize:=26, _
FontBold:=True, FontItalic:=False, Left:=575, Top:=100)
Set newWordArt = Worksheets(2).Shapes. _
AddTextEffect(PresetTextEffect:=msoTextEffect3, _
Text:="WATCH THIS", FontName:="Ravie", FontSize:=26, _
FontBold:=True, FontItalic:=False, Left:=125, Top:=400)
Worksheets(2).Shapes(1).Fill.ForeColor.RGB = RGB(255, 100,
0)
Worksheets(2).Shapes(2).Fill.ForeColor.RGB = RGB(200, 255,
150)
End If
If counter = 2 Or counter = 4 Or counter = 6 Or counter = 8
Or _
counter = 10 Then
Worksheets(2).Shapes(1).IncrementLeft -450
Worksheets(2).Shapes(2).IncrementLeft 450
End If
If counter = 3 Or counter = 5 Or counter = 7 Or counter = 9
Then
Worksheets(2).Shapes(1).IncrementLeft 450
Worksheets(2).Shapes(2).IncrementLeft -450
End If
Rng1.Interior.ColorIndex = counter
Rng2.Interior.ColorIndex = counter + 4
Rng3.Interior.ColorIndex = counter + 7
Rng4.Interior.ColorIndex = counter + 9
HalfSecDly
counter = counter + 1
Loop Until counter = 11
Rng1.BorderAround LineStyle:=(-4142)
Rng2.BorderAround LineStyle:=(-4142)
Rng3.BorderAround LineStyle:=(-4142)
Rng4.BorderAround LineStyle:=(-4142)
Worksheets(2).Shapes(2).Delete
Worksheets(2).Shapes(1).Delete
End Sub

Public Function HalfSecDly()
s = Timer + 0.5
Do While Timer < s
DoEvents
Loop
End Function

"MAX" wrote in message
...
I need a code for a workbook of 3 sheets. This code must do flashing cells
(not fonts) and the sheets are named ( Serie A, Serie B and Serie C).

I want these flashing cells as soon I open the workbook.

Serie A ( Cells AN6 and AW6)

Serie B ( Cells AN6 and AW6)

Serie C ( Cells AN6, AW6, AN83 and AW83).

Thanks for your help.