Flashing text and Floating box

[Sourdust]

Sorry to bring this up again but the answer below is exactly what I need except I want cells A:L to flash in a particular row if cell H in that row is blank, otherwise no change.

Also is it possible to have a floating text box with text and then the result of a formula in a cell, eg "Unsetlled Claims (=N2)"?

Thanks for any help and thanks to Phil and Dave for the original solutions.

Sourdust

Q - Can this code be changed so that if cell I54="Quarter End" then Cell F13 blinks? And if it doesn't = "Quarter End" then Cell B13 blinks?



quote:
--------------------------------------------------------------------------------
Originally posted by Drdave1958:
Here is building on Phils code..........


Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("I54").Value = "Quarter End" Then
For n = 1 To 10
Range("F13").Font.Color = vbRed
Delay (0.25)
Range("F13").Font.Color = vbWhite
Delay (0.25)
Next n
ElseIf Range("I54").Value <> "Quarter End" Then
For n = 1 To 10
Range("B13").Font.Color = vbRed
Delay (0.25)
Range("B13").Font.Color = vbWhite
Delay (0.25)
Next n
End If
Range("F13,B13").Font.Color = vbBlack
End Sub



Adjust the numeric value in the "Delay" line to control how long it blinks.

-Dave-

 

[jimboy]

Try this, the message box will disappear after 2 secs...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim n As Long
If Target.Count > 1 Then Exit Sub
If Target.Column = 8 And Target.Value = "" Then
For n = 1 To 10
Range("A" & Target.Row & ":L" & Target.Row).Font.Color = vbRed

Delay (0.25)
Range("A" & Target.Row & ":L" & Target.Row).Font.Color = vbWhite
Delay (0.25)
Next n
CreateObject("WScript.Shell").Popup "Unsetlled Claims: " & Range("N2").Value, 2, "Wait!"
End If

Range("A" & Target.Row & ":L" & Target.Row).Font.Color = vbBlack
End Sub

PS. It would have helped if you had posted the Delay code...

 

[Sourdust]

Sorry Jimmy I am way out my depth here. I have put that code into a module but nothing happened. Maybe something to do with the "delay code"because I don't know what that is.

Thanks for your time.

 

[jimboy]

Right mouse over the sheet name i.e. Sheet1 and select view code, then paste this in;

Sub Delay(rTime As Single)
'delay rTime seconds (min=.01, max=300)
Dim oldTime As Variant
'safety net
If rTime < 0.01 Or rTime > 300 Then rTime = 1
oldTime = Timer
Do
DoEvents
Loop Until Timer - oldTime > rTime
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim n As Long
If Target.Count > 1 Then Exit Sub
If Target.Column = 8 And Target.Value = "" Then
For n = 1 To 5
Range("A" & Target.Row & ":L" & Target.Row).Font.Color = vbRed

Delay (0.25)
Range("A" & Target.Row & ":L" & Target.Row).Font.Color = vbWhite
Delay (0.25)
Next n
CreateObject("WScript.Shell").Popup "Unsetlled Claims: " & Range("N" & Target.Row).Value, 2, "Wait!"
End If

Range("A" & Target.Row & ":L" & Target.Row).Font.Color = vbBlack
End Sub

Now delete a value in column H and the code will run.

 

[Sourdust]

That works perfectly Jim. I probably didn't explain it well enough but I want cells A:L where cell H is blank to flash when the file is opened. It is to highlight the unsettled claims when they are checked monthly.

Thanks again and sorry if I am being a pain.

 

[jimboy]

Right mouse over the excel icon to the left of file and select view code, then paste this in (if you have more than one sheet you need to change the code so it is selected first - because another sheet could have been selected the last time the file was opened!)

Sub Delay(rTime As Single)
'delay rTime seconds (min=.01, max=300)
Dim oldTime As Variant
'safety net
If rTime < 0.01 Or rTime > 300 Then rTime = 1
oldTime = Timer
Do
DoEvents
Loop Until Timer - oldTime > rTime
End Sub

Private Sub Workbook_Open()
On Error Resume Next
'*********************************************
'If you have more than one you need to select it first

'Sheets("Sheet2").Select

'*********************************************

Dim n As Long
For n = 1 To 10
Range("H2:H" & Range("A65536").End(xlUp).Offset(0, 7).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Font.Color = vbRed
Delay (0.25)
Range("H2:H" & Range("A65536").End(xlUp).Offset(0, 7).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Font.Color = vbWhite
Delay (0.25)
Next n
CreateObject("WScript.Shell").Popup "Unsetlled Claims: " & Range("N2").Value, 2, "Wait!"
Range("H2:H" & Range("A65536").End(xlUp).Offset(0, 7).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Font.Color = vbBlack
End Sub

 

[Sourdust]

Jim

I have pasted that code to ThisWorkbook but I already have a Private Sub Workbook_Open() in there for a splashscreen so I get ambiguous name detected and it won't run. I have tried renaming it to Private Sub Workbook_Open1() but that didn't work. I also pasted it into a module but no joy there either. Sorry again if I am just being dumb.

 

[Sourdust]

I have deleted the routine in ThisWorkbook for the Splashscreen and moved it to a module. Unfortunately the network here won't let me save the file when I paste the code in. It will have to wait now until Monday.

Thanks again and have a good weekend

 

[jimboy]

You can either change it to a macro and call the macro from the workbook_open or add it to the workbook_open (below the exsisting code - if you choose this can you post your code?) - let me know...

 

[Sourdust]

Sorry Jim but I am trapped in meetings nearly all day and then on holiday until Friday. I will get to it as soon as I can.

Thanks again for all your help.