I need to flash a cell red if it is greater than a number. I need to set multiple cells to do this. I have forumla pointing to a DDE datasource that constantly updates the cell.
Printable View
I need to flash a cell red if it is greater than a number. I need to set multiple cells to do this. I have forumla pointing to a DDE datasource that constantly updates the cell.
you could use application.ontime to flash the cells, although it would not be very precise, at least it would not lockup you application
I just need it to flash until the number goes below the number I specify. So how would the code look?
Test this and see if it does what you expect:
This should all be posted in the 'ThisWorkbook' module of your file. And as I always say make sure to test in a copy of your workbook, so that if the macro doesn't work the original data isn't lost.
The code will start running as soon as you open the file, due to the Workbook_Open event. I've also included manual TurnOn and TurnOff macros if you need to stop the code auto-running every second.
Hope this helps!
Code:Option Explicit
Dim nextTick
Private Sub Workbook_Open()
nextTick = Now + TimeValue("00:00:01")
Application.OnTime nextTick, "ThisWorkbook.prFlashCell"
End Sub
Private Sub Workbook_Close()
Application.OnTime nextTick, "ThisWorkbook.prFlashCell", , False
End Sub
Sub prTurnOn()
nextTick = Now + TimeValue("00:00:01")
Application.OnTime nextTick, "ThisWorkbook.prFlashCell"
End Sub
Sub prTurnOff()
Application.OnTime nextTick, "ThisWorkbook.prFlashCell", , False
End Sub
Sub prFlashCell()
Dim rngC As Range
Dim chkRng As Range
Dim chkVal As Double
Dim RGBCol As Long
'------------------------------------------------------
'Start of User Settings // Change the below to be equal to your settings
'------------------------------------------------------
'Range of values to look at and check values of
Set chkRng = ActiveSheet.Range("A1:B4")
'Value to check for // If less than this value the cell will not flash
chkVal = 5
'Colour to flash // Set as RGB Color Values
RGBCol = RGB(255, 0, 0)
'------------------------------------------------------
'End of User Settings // Do not change the following code
'------------------------------------------------------
For Each rngC In chkRng.Cells
If rngC.Value < chkVal Then
rngC.Interior.Pattern = xlNone
Else
With rngC.Interior
If .Color = RGBCol Then
.Pattern = xlNone
Else
.Pattern = xlSolid
.Color = RGBCol
End If
End With
End If
Next rngC
nextTick = Now + TimeValue("00:00:01")
Application.OnTime nextTick, "ThisWorkbook.prFlashCell"
End Sub
couple of questions. First thank you for the code. Second what if I want it to change color based off a name change like if cell = "stuff" ?
Second, how do I assinged this code to an individual cell? I don't want to flash a range. I want to flash Maybe A1 if it says stuff. Then I might want to flash B5 if it is > than 2 and so on.
Ok, I think it can be done however these conditions weren't stated in your original post. You definitely didn't mention checking cells for whether they were equal to a string. :)
I'm sure there's a much more elegant way of doing this, but what I've come up with is below.
Paste the following, again all in the ThisWorkbook code:
Now all you have to do is enter the conditions into the array of checks in the same format as shown.Code:Option Explicit
Dim nextTick
Private Sub Workbook_Open()
nextTick = Now + TimeValue("00:00:01")
Application.OnTime nextTick, "ThisWorkbook.prFlashSpecificCell"
End Sub
Private Sub Workbook_Close()
Application.OnTime nextTick, "ThisWorkbook.prFlashSpecificCell", , False
End Sub
Sub prTurnOn()
nextTick = Now + TimeValue("00:00:01")
Application.OnTime nextTick, "ThisWorkbook.prFlashSpecificCell"
End Sub
Sub prTurnOff()
Application.OnTime nextTick, "ThisWorkbook.prFlashSpecificCell", , False
End Sub
Sub prFlashSpecificCell()
Dim arrstrRngVals() As String
Dim numChks As Long
Dim RGBCol As Long
Dim ubArr As Long
Dim lbArr As Long
'------------------------------------------------------
'Start of User Settings // Change the below to be equal to your settings
'------------------------------------------------------
'Set the number of checks that you need
numChks = 5
'--------------------------------
'DO NOT CHANGE
ReDim arrstrRngVals(1 To numChks)
'--------------------------------
'Set each of the values below to the cells you want to check
'In the format:
'[Cell address],[operator],[value to check]
arrstrRngVals(1) = "$A$1,=,stuff"
arrstrRngVals(2) = "$B$5,>,2"
arrstrRngVals(3) = "$A$2,=,stuff"
arrstrRngVals(4) = "$A$3,=,stuff"
arrstrRngVals(5) = "$A$4,=,stuff"
'Colour to flash // Set as RGB Color Values
RGBCol = RGB(255, 0, 0)
'------------------------------------------------------
'End of User Settings // Do not change the following code
'------------------------------------------------------
lbArr = LBound(arrstrRngVals)
ubArr = UBound(arrstrRngVals)
Dim i As Long
For i = lbArr To ubArr
With ActiveSheet.Range(Left(arrstrRngVals(i), InStr(arrstrRngVals(i), ",") - 1)).Interior
If ThisWorkbook.fnEvalStr(arrstrRngVals(i)) Then
If .Color = RGBCol Then
.Pattern = xlNone
Else
.Pattern = xlSolid
.Color = RGBCol
End If
Else
.Pattern = xlNone
End If
End With
Next i
nextTick = Now + TimeValue("00:00:01")
Application.OnTime nextTick, "ThisWorkbook.prFlashSpecificCell"
End Sub
Function fnEvalStr(str As String) As Boolean
Dim findComma As Long
Dim rng As Range
Dim rngStr As String
Dim operator As String
Dim val As String
Dim tempStr As String
findComma = InStr(str, ",")
rngStr = Left(str, findComma - 1)
tempStr = Right(str, Len(str) - findComma)
findComma = InStr(tempStr, ",")
operator = Left(tempStr, findComma - 1)
val = Right(tempStr, Len(tempStr) - findComma)
If Not IsNumeric(val) Then
val = """" & val & """"
End If
fnEvalStr = Evaluate("IF(" & rngStr & operator & val & ", TRUE, FALSE)")
End Function
As long as it is entered in the correct format, the included function will split the parts of it out and check the cell using the specified operator to find if the cell should be coloured or not.
Remember that if you want to include more than the standard 5 checks you'll need to change not only the numbered variable but also add a new line for the condition matching the lines that already exist.
Perfect. I think I have just what I need. I found the color value table to make them change. Thanks for helping me. I would have done this a totally different and harder way. I did notice that I can only select one color. What do I do if I want another cell to be something different. The one in your code is global. I may want another cell to go green. I also noticed the cell will not flash if I have a condtional format over the same cell. I have conditional format that chagnes a different color to highlight a range of cells. When that is in color, then the vb doesn't run.
yes it does run but the interior.color is concealed by the conditional format, so while the interior colour is changing it is not visible to the userQuote:
When that is in color, then the vb doesn't run.
you could flash the colour of the conditional format but that would be more complex
what are my options?
each range (cell) can have multiple format conditions, these are in a collection of format conditions, of how many are set, you would need to loop the the collection to find the appropriate one that controls the interior colour
if you want to flash the entire row, you would need to test and flash every cell in the row individually, or set the conditional format on the entire range, but be able to return the range back to the previous values
Okay but how do I do that? What code is used? I need to have the option to change different colors. I may want a cell to be green and not red. Also what do I do about the conditional formatting? Turn it off and use VB? I have a range of cells that need to turn red based on > 0 but then I want certain cells within that range to flash > 0 and not be affected by the range of cells that are red. Some of the cells that flash need to flash yellow, some red and some green. Are we far off from doing this?
i think a long way, while this is possible, i do not believe you realise how complex it is to do what you are requesting, when some cells may have conditional formatting and others not, with multiple colours flashing, plus remembering the original values for when turning off the flashingQuote:
Are we far off from doing this?
I do appreciate all the help and I understand if you guys don't want to get crazy with all that code but how can I get this done?
Right if we're going to go to town on it may as well do it properly :)
Try the code below. Make sure to start with no conditional formatting and no fill colours set in the cells you are testing. In my opinion if you want to have some flashing cells and some constant cells, you should do it all via VBA.
See the examples in the checks I posted to see how this new code has various improvements over the original code, the main one being that you can include multiple cells in one condition statement.
Bear in mind that this obviously does change the cells fill colour, so once turned off, unlike conditional formatting the cell will not revert to its previous colour.
Hope this helps!
Code:Option Explicit
Option Base 1
Dim nextTick
Private Sub Workbook_Open()
Call ThisWorkbook.prTurnOn
End Sub
Private Sub Workbook_Close()
Call ThisWorkbook.prTurnOff
End Sub
Sub prTurnOn()
nextTick = Now + TimeValue("00:00:01")
Application.OnTime nextTick, "ThisWorkbook.prVBACondFormat"
End Sub
Sub prTurnOff()
Application.OnTime nextTick, "ThisWorkbook.prVBACondFormat", , False
End Sub
Sub prVBACondFormat()
Dim arrChecks() As Variant
Dim arrTemp() As Variant
Dim numChecks As Long
Dim ws As Worksheet
Dim rngFull As Range
Dim rngC As Range
Dim operator As String
Dim val As String
Dim tempVal As String
Dim RGBCol As Long
Dim boolFlash As Boolean
Dim ubArrC As Long
Dim lbArrC As Long
'------------------------------------------------------
'Start of User Settings // Change the below to be equal to your settings
'------------------------------------------------------
'Set the number of checks that you need
numChecks = 5
'--------------------------------
'DO NOT CHANGE
ReDim arrChecks(1 To numChecks)
'--------------------------------
'Set each of the values below to the conditions you want to check
'In the format:
'Array( [Cell address], [operator], [value to check], [RGB Colour], [boolFlash] )
'Where:
'[Cell address], String, "$A$1"
'[operator], String, "=", ">", "<=" etc
'[value to check], String/Numerical, "Stuff", 5
'[RGB Colour], Numerical, RGB(255, 0, 0) = Red
'[boolFlash], Boolean (True/False), True = Flash cell, False = Constant cell colour
arrChecks(1) = Array("$A$1", "=", "Stuff", RGB(255, 0, 0), True)
arrChecks(2) = Array("$B$5", ">", 5, RGB(0, 255, 0), True)
arrChecks(3) = Array("$A$4, $A$7, $A$10", ">=", 5, RGB(0, 0, 255), False)
arrChecks(4) = Array("$C$1:$C$7", "=", "ThisString", RGB(0, 255, 0), False)
arrChecks(5) = Array("$D$1:$D$4", "<=", 10, RGB(204, 255, 180), True)
'Change to the worksheet you want the code to run for.
Set ws = ThisWorkbook.Worksheets("Sheet1")
'------------------------------------------------------
'End of User Settings // Do not change the following code
'------------------------------------------------------
lbArrC = LBound(arrChecks, 1)
ubArrC = UBound(arrChecks, 1)
Dim i As Long
For i = lbArrC To ubArrC
arrTemp = arrChecks(i)
Set rngFull = ws.Range(arrTemp(1))
operator = arrTemp(2)
val = arrTemp(3)
tempVal = val
RGBCol = arrTemp(4)
boolFlash = arrTemp(5)
For Each rngC In rngFull.Cells
val = tempVal
With rngC.Interior
If ThisWorkbook.fnEvalCell(rngC, operator, val) Then
If boolFlash = True Then
If .Color = RGBCol Then
.Pattern = xlNone
Else
.Pattern = xlSolid
.Color = RGBCol
End If
Else
.Pattern = xlSolid
.Color = RGBCol
End If
Else
.Pattern = xlNone
End If
End With
Next rngC
Next i
nextTick = Now + TimeValue("00:00:01")
Application.OnTime nextTick, "ThisWorkbook.prVBACondFormat"
End Sub
Function fnEvalCell(rng As Range, operator As String, val As String) As Boolean
If Not IsNumeric(val) Then
val = """" & val & """"
End If
fnEvalCell = Evaluate("IF(" & rng.Address & operator & val & ", TRUE, FALSE)")
End Function
Will test the code. Thanks so much
Your code works but when I change this line, I get subscript out of range.
arrChecks(2) = Array("$AJ$21", ">", 5, RGB(0, 255, 0), True)
When every I change any of these I get that error.
Oh I see. I need to put the top portion you posted in module 1? The the bottom code in thisworkbook ?
I only pasted the bottom code. I assume I paste just the one section above and the last one together?
Like I say I put all of it into ThisWorkbook. None of the code should go anywhere else or it is likely to not work.
You can see it from this line:
That it is looking for the macro to run inside ThisWorkbook.Code:Application.OnTime nextTick, "ThisWorkbook.prVBACondFormat"
Still cannot get it to work. All pasted under thisworkbook
I want a range of cells to flash if H12 says "stuff" (I want to change the name to stuff to whatever I want). All I get is "subscript out of range"Code:Option Explicit
Option Base 1
Dim nextTick
Private Sub Workbook_Open()
Call ThisWorkbook.prTurnOn
End Sub
Private Sub Workbook_Close()
Call ThisWorkbook.prTurnOff
End Sub
Sub prTurnOn()
nextTick = Now + TimeValue("00:00:01")
Application.OnTime nextTick, "ThisWorkbook.prVBACondFormat"
End Sub
Sub prTurnOff()
Application.OnTime nextTick, "ThisWorkbook.prVBACondFormat", , False
End Sub
Sub prVBACondFormat()
Dim arrChecks() As Variant
Dim arrTemp() As Variant
Dim numChecks As Long
Dim ws As Worksheet
Dim rngFull As Range
Dim rngC As Range
Dim operator As String
Dim val As String
Dim tempVal As String
Dim RGBCol As Long
Dim boolFlash As Boolean
Dim ubArrC As Long
Dim lbArrC As Long
'------------------------------------------------------
'Start of User Settings // Change the below to be equal to your settings
'------------------------------------------------------
'Set the number of checks that you need
numChecks = 5
'--------------------------------
'DO NOT CHANGE
ReDim arrChecks(1 To numChecks)
'--------------------------------
'Set each of the values below to the conditions you want to check
'In the format:
'Array( [Cell address], [operator], [value to check], [RGB Colour], [boolFlash] )
'Where:
'[Cell address], String, "$A$1"
'[operator], String, "=", ">", "<=" etc
'[value to check], String/Numerical, "Stuff", 5
'[RGB Colour], Numerical, RGB(255, 0, 0) = Red
'[boolFlash], Boolean (True/False), True = Flash cell, False = Constant cell colour
arrChecks(1) = Array("$H$12", "=", "stuff", RGB(255, 0, 0), True)
arrChecks(2) = Array("$B$5", ">", 5, RGB(0, 255, 0), True)
arrChecks(3) = Array("$A$4, $A$7, $A$10", ">=", 5, RGB(0, 0, 255), False)
arrChecks(4) = Array("$C$1:$C$7", "=", "ThisString", RGB(0, 255, 0), False)
arrChecks(5) = Array("$D$1:$D$4", "<=", 10, RGB(204, 255, 180), True)
'Change to the worksheet you want the code to run for.
Set ws = ThisWorkbook.Worksheets("Sheet1")
'------------------------------------------------------
'End of User Settings // Do not change the following code
'------------------------------------------------------
lbArrC = LBound(arrChecks, 1)
ubArrC = UBound(arrChecks, 1)
Dim i As Long
For i = lbArrC To ubArrC
arrTemp = arrChecks(i)
Set rngFull = ws.Range(arrTemp(1))
operator = arrTemp(2)
val = arrTemp(3)
tempVal = val
RGBCol = arrTemp(4)
boolFlash = arrTemp(5)
For Each rngC In rngFull.Cells
val = tempVal
With rngC.Interior
If ThisWorkbook.fnEvalCell(rngC, operator, val) Then
If boolFlash = True Then
If .Color = RGBCol Then
.Pattern = xlNone
Else
.Pattern = xlSolid
.Color = RGBCol
End If
Else
.Pattern = xlSolid
.Color = RGBCol
End If
Else
.Pattern = xlNone
End If
End With
Next rngC
Next i
nextTick = Now + TimeValue("00:00:01")
Application.OnTime nextTick, "ThisWorkbook.prVBACondFormat"
End Sub
Function fnEvalCell(rng As Range, operator As String, val As String) As Boolean
If Not IsNumeric(val) Then
val = """" & val & """"
End If
fnEvalCell = Evaluate("IF(" & rng.Address & operator & val & ", TRUE, FALSE)")
End Function
I read, you want to flash a range of cells red if they are greater than a number.
Now we are no longer talking about numbers, we have moved onto text.
Another example of specifying different conditions.
Red was specified in your original post, so that was all that was given.
Multiple colours are now involved, all linked to different conditions.
Finally it seems that it is not flashing the cells if those particular cells meet the condition, but instead flash the cells if a cell outside the range meets the condition.
I don't mean to sound like I'm ranting but your original post did not go into enough detail if this is what you finally wanted to achieve. So far nearly all of your posts specify something different that needs to be done.
As the code stands at the moment, it is the cell you specify that is checked. As an example if you put
Array("$A$1", "=", "stuff", RGB(255, 0, 0), True)
and A1 is equal to "stuff" it will flash red. If it isn't it will stop flashing. There is no way with the current code to check if A2 is equal to "stuff" and flash A1 if it is. The cell that flashes is the same cell that's checked.
Give me a few days and I'll see what I can come up with :rolleyes:
sorry man. I need the text and numbers. Take your time. I'm no coder and I appreciate the help