I have the following conditions when I create a worksheet via vba, the first two work fine in that if the cell date is two days prior to today's date then it turns orange or if the cell date is due/overdue the cell turns red, what doesn't work at all is the last condition, it is simply ignored. The condition I would like is if the cell P2 is not blank it turns cell O2 green. I have no idea what I am doing wrong, any advice would be greatly appreciated
Set MyRange = Range("o2:o" & J)
Set MyRange1 = Range("P2:P" & J)
MyRange.FormatConditions.Add Type:=xlExpression, Formula1:="=AND($O2>TODAY(),$O2<=
(TODAY()+2))"
MyRange.FormatConditions(1).Interior.Color = RGB(255, 153, 51)
MyRange.FormatConditions.Add Type:=xlCellValue, Operator:=xlLessEqual, _
Formula1:="=NOW()"
MyRange.FormatConditions(2).Interior.Color = RGB(255, 0, 0)
MyRange1.FormatConditions.Add Type:=xlExpression, Formula1:="=P2<>"""
MyRange.FormatConditions(3).Interior.Color = RGB(0, 153, 0)
Related
Is there any way I can add a pattern onto a colored cell through VBA such that the color of the cell remains visible?
I am trying to do a sort of Gantt chart, where the different colours represent different people, and and want the active cell to get a pattern above to get a better view of where you are with the cursor:
In below I move the cursor one cell up. The corresponding row gets a pattern, but the red colour disappears. If I move the cursor one cell up and to the left, the same happens with the yellow colour.
I've tried VBA code below:
LR = Cells(Rows.Count, 1).End(xlUp).Row
Set PatternRng = Range("A6" & ":" & "GM" & Sheets("Source").Range("I1").Value)
PatternRng.Interior.Pattern = xlPatternNone
If ((ActiveCell.Row >= 7) And (ActiveCell.column <= 194) And (ActiveCell.Row <= LR)) Then
If (ActiveCell.column > 1) Then
Set PatternRng = Range("A6:A" & LR).Offset(, ActiveCell.column - 1)
PatternRng.Interior.Pattern = xlPatternGray25
PatternRng.Interior.PatternColor = RGB(191, 191, 191)
End If
Set PatternRng = Range("A6:GM6").Offset(ActiveCell.Row - 6, 0)
PatternRng.Interior.Pattern = xlPatternGray25
PatternRng.Interior.PatternColor = RGB(191, 191, 191)
Sheets("Source").Range("I2").Value = (ActiveCell.column - 1)
Sheets("Source").Range("I3").Value = (ActiveCell.Row - 6)
End If
Sheets("Source").Range("I1").Value = LR
I've also tried conditional formatting through VBA but I get the same result. But as the picture below shows it is possible if you do it manuelly on a cell.
Thanks in advance!
In testing, this line cleared any interior color.
PatternRng.Interior.Pattern = xlPatternNone
Instead, try
PatternRng.Interior.Pattern = xlSolid ' Solid color
or maybe:
PatternRng.Interior.Pattern = xlPatternAutomatic ' Excel controls the pattern
I would like to write a VBA that changes the color of cells that begin with specific words ("Enter", "Error", "Used", "Charge No") e.g. "Error! Input does not match material". I'm quite new to VBA and tried different things but I get stuck every time and get the error
"Type mismatch".
What I got so far is this:
Sub highlight()
Dim cell As Range
For Each cell In Range("D2:E2").EntireColumn
If cell.Value = "Enter" Then
cell.Interior.color = RGB(221, 235, 247)
ElseIf cell.Value = "Error" Then
cell.Interior.color = RGB(253, 145, 145)
ElseIf cell.Value = "add Charge No" Then
cell.Interior.color = RGB(255, 242, 204)
ElseIf cell.Value = "Used" Then
cell.Interior.color = RGB(255, 242, 204) '
End If
Next
End Sub
Just a simple screenshot example of how easy life can be using conditional formatting (done in less than five minutes):
In case you prefer not to use conditional formatting because you want to avoid copying the conditional formatting, you might consider using "Paste - Values".
I'm trying to write a VBA in order to change the color (between two different ones) of a table row if the content of a cell is different from the previous.
The row n. 3 must have this color: RGB(221, 245, 253), while the other color is white.
I'm not able to figure out which would be the logic code and how to change the background color of the cells without changing the font color.
Public Sub Overview()
Dim Ovtask As String
Dim Ovn, Ovi As Integer
Ovn = Range("B2").CurrentRegion.Rows.Count
Range("B3:C3").Font.Color = RGB(221, 245, 253)
For Ovi = 3 To Ovn + 1
Ovtask = Range("B" & Ovi)
If Range("B" & Ovi + 1) = Ovtask Then
Range("B" & Ovi + 1 & ":" & "C" & Ovi + 1).Font.Color = Range("B" & Ovi & ":" & "C" & Ovi).Font.Color
Else
Range("B" & Ovi + 1 & ":" & "C" & Ovi + 1).Font.Color = RGB(0, 0, 0)
End If
Next Ovi
End Sub
In the linked image you can see what would be the desired result
As BigBen states in the comments, to set the color of a cell, you use Interior.Color. I thought about conditional formatting, but I think you are right, it's not possible in this case.
The logic you use in your code is flawed: Once it sets a row to white, it will never set any row to blue: Either the next row is equal, then you set it to white because the current row is white, or it is not equal, then you set it to white anyhow.
Have a look to the following code snippet: I declare a boolean variable UseHighlightColor that keeps track if the current row needs to be colored blue or not and sets the Interior.Color accordingly. Some remarks to the color:
- white is RGB(255, 255, 255). RGB(0, 0, 0) results in black.
- there is a predefined constant vbWhite you could use.
- To set the cells transparent instead of white, you can use ColorIndex = xlNone.
And a remark to your code: You are using Range unqualified, so VBA automatically refers to the ActiveSheet (the sheet that has currently the focus). This is not always the sheet you work with. In my example, I have written With ActiveSheet, but you can easily change this so that the code uses the sheet you want, eg ThisWorkbook.Sheets(1). Inside the With, I use the syntax .Range (with leading .), this tells VBA to use the object (sheet) defined in the With-clause. Don't rely on ActiveSheet (and don't use Activate).
With ActiveSheet
Ovn = .Range("B2").CurrentRegion.Rows.Count
Dim useHighLightColor As Boolean
useHighLightColor = True
For Ovi = 3 To Ovn + 1
Dim currentCell As Range
Set currentCell = .Range("B" & Ovi)
If useHighLightColor Then
currentCell.Resize(1, 2).Interior.Color = RGB(221, 245, 253)
Else
' curentCell.Resize(1, 2).Interior.Color = vbWhite
currentCell.Resize(1, 2).Interior.ColorIndex = xlNone
End If
If currentCell <> currentCell.Offset(1, 0) Then
' Switch color
useHighLightColor = Not useHighLightColor
End If
Next Ovi
End With
UPDATE
Thank you for the assistance. I have updated my code to look like:
Sub AddColor()
With Sheet1.Range("$T$3:$T$3600").FormatConditions
.Delete
With .Add(xlExpression, Formula1:="=AND(($Q3+7)<=TODAY(),$Q3>0,$T3="""")")
.Interior.Color = RGB(0, 176, 240)
.StopIfTrue = False
End With
With .Add(xlExpression, Formula2:="=AND(($Q3+14)<=TODAY(),$Q3>0,$T3="""")")
.Interior.Color = RGB(255, 0, 0)
.StopIfTrue = True
End With
End With
With Sheet1.Range("$U$3:$U$3600").FormatConditions
.Delete
With .Add(xlExpression, Formula1:="=AND(($S3-1)<=TODAY(),$S3>0,$U3="""")")
.Interior.Color = RGB(0, 176, 240)
.StopIfTrue = False
End With
With .Add(xlExpression, Formula2:="=AND(($T3+1)<=TODAY(),$U3="""",$T3>0)")
.Interior.Color = RGB(255, 0, 0)
.StopIfTrue = True
End With
End With
'Code continues
I am now getting an error that says "Argument Not Optional" and it seems to be referring to my "Formula2" line on the first set of statements. I am not sure what argument is missing, as it is working correctly for the first statement. I tried to skip over the second formula and it has the same error for the next set for arguments.
It is probably something simple, but any assistance is appreciated!
UPDATE
I am trying to add conditional formatting through VBA, but am running into some issues with my code. I would like to be able to do it through the conditional formatting function, but the data that is going to be imported requires that i split columns, which causes the reference cells to change, but conditional formatting does not seem to keep it how I want it (long story). Anyway, I have about 10 more of these to format the information in the corresponding columns and am just trying to figure out why I keep getting an error. Here is what I have:
Sub AddColor()
With Sheet1.Range("$T$3:$T$3600")
.FormatConditions.Add xlExpression, Formula1:="=AND(($Q3+7)
<=TODAY(),$Q3>0,$T3="")"
.FormatConditions(1).Interior.Color = RGB(0, 176, 240)
.FormatConditions(1).StopIfTrue = False
.FormatConditions.Add xlExpression, Formula2:="=AND(($Q3+14)
<=TODAY(),$Q3>0,$T3=0)"
.FormatConditions(2).Interior.Color = RGB(255, 0, 0)
.FormatConditions(2).StopIfTrue = True
End With
With Sheet1.Range("$U$3:$U$3600")
.FormatConditions.Add xlExpression, Formula1 = "=AND(($S3-1
<=TODAY(),$S3>0,$U3="")"
.FormatConditions(3).Interior.Color = RGB(0, 176, 240)
.FormatConditions(3).StopIfTrue = False
.FormatConditions.Add xlExpression, Formula2 = "=AND(($T3+1)
<=TODAY(),$U3="",$T3>0)"
.FormatConditions(4).Interior.Color = RGB(255, 0, 0)
.FormatConditions(4).StopIfTrue = True
End With
(the<=TODAY() portion is a continuation i my code, it just jumped to the next line due to formatting.) What am I doing wrong? Any assistance would be greatly appreciated!
Your statement
.FormatConditions.Add xlExpression, Formula1:="=AND(($Q3+7)<=TODAY(),$Q3>0,$T3="")"
is trying to tell Excel to use a formula of =AND(($Q3+7)<=TODAY(),$Q3>0,$T3="). That is syntactically incorrect, as there is no closing quote for the part that starts $T3=".
You need to escape all double-quotation marks (") within string literals in VBA code by using two double-quotation marks (i.e. "") for every one you actually want in the string.
I believe you want your code to be:
Sub AddColor()
With Sheet1.Range("$T$3:$T$3600")
.FormatConditions.Add xlExpression, Formula1:="=AND(($Q3+7)<=TODAY(),$Q3>0,$T3="""")"
.FormatConditions(1).Interior.Color = RGB(0, 176, 240)
.FormatConditions(1).StopIfTrue = False
.FormatConditions.Add xlExpression, Formula2:="=AND(($Q3+14)<=TODAY(),$Q3>0,$T3=0)"
.FormatConditions(2).Interior.Color = RGB(255, 0, 0)
.FormatConditions(2).StopIfTrue = True
End With
With Sheet1.Range("$U$3:$U$3600")
.FormatConditions.Add xlExpression, Formula1:="=AND(($S3-1)<=TODAY(),$S3>0,$U3="""")"
.FormatConditions(3).Interior.Color = RGB(0, 176, 240)
.FormatConditions(3).StopIfTrue = False
.FormatConditions.Add xlExpression, Formula2:="=AND(($T3+1)<=TODAY(),$U3="""",$T3>0)"
.FormatConditions(4).Interior.Color = RGB(255, 0, 0)
.FormatConditions(4).StopIfTrue = True
End With
In addition to the corrections made by YowE3K, I suggest you make a few other improvements. The way you are referring to the newly added CFs is hazardous. I suggest:
1- delete any old CF before adding new ones in the macro. Otherwise they will keep accumulating each time you run the macro and accordingly theit indexes will not be what you "think" they are.
2- Refer explicitly to any newly added CF instead of by index. For example, in the column U, you refer to them as .FormatConditions(3) and (4), which is incorrect.
With Sheet1.Range("$U$3:$U$3600").FormatConditions
.Delete ' <--- delete old CF if any
With .Add(xlExpression, Formula1:="=AND(($S3-1)<=TODAY(),$S3>0,$U3="""")")
.Interior.Color = RGB(0, 176, 240)
.StopIfTrue = True
'...
End With
With .Add(xlExpression, Formula1:="=AND(($T3+1)<=TODAY(),$U3="""",$T3>0)")
.Interior.Color = RGB(255, 0, 0)
.StopIfTrue = True
'...
End With
End with
Apply the same method for each CF you want to add, and don't forget to "double-up" your formula's double-quotes that you embed inside a VBA string.
I have written a simple Excel VBA macro to have different formatting in a single cell. I have a formula that returns one of 4 possible values:
l1
l2
l3
l4
I wish to format this as Wingdings for the first character with a colour based on the number - 1 = red, 2 = orange, 3 = yellow and 4 = green.
What I have done is to put in an event trigger on cell change:
Private Sub Worksheet_Change(ByVal Target As Range)
Call Wingdings(Target)
End Sub
The subroutine is as follows:
Sub Wingdings(rCll As Range)
If rCll.Value = "l1" Or rCll.Value = "l2" Or _
rCll.Value = "l3" Or rCll.Value = "l4" Then
Select Case Right(rCll.Value, 1)
Case 1 'Red
With rCll.Characters(Start:=1, Length:=1).Font
.Name = "Wingdings"
.Color = RGB(255, 0, 0)
End With
Case 2 'Orange
With rCll.Characters(Start:=1, Length:=1).Font
.Name = "Wingdings"
.Color = RGB(255, 153, 0)
End With
Case 3 'Yellow
With rCll.Characters(Start:=1, Length:=1).Font
.Name = "Wingdings"
.Color = RGB(255, 255, 0)
End With
Case 4 'Green
With rCll.Characters(Start:=1, Length:=1).Font
.Name = "Wingdings"
.Color = RGB(0, 255, 0)
End With
End Select
End If
End Sub
My issue here is that if I manually enter eg l4, the code runs perfectly. But as soon as I determine this value using a formula, it stops working as I desire. I end up with this:
Can anyone suggest a solution to allow me to format the result of the formula as I desire?
What you have works.
Maybe call something like this on the Change event instead, conditionally, if you are dragging formulas
Sub fixstuff()
For Each cell In Selection
cell.Select
Call Wingdings(Range(cell.Address))
Next cell
End Sub