This question already has an answer here:
VBA Conditional Formatting if Cell Not Between
(1 answer)
Closed 7 years ago.
I have this VBA code for conditional formatting.
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotBetween, _
Formula1:="=$I$10", Formula2:="=$J$10"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub
I have a vbscript that creates an Excel sheet and I need to apply that VBA code to a cell in the Excel sheet as it is created. Having issues getting it to run. I know I need to sub the actual values for the excel constants but there's more to it I just don't get
What I've done so far
priceRange = "K"&rowNum + 2
objWorkSheet.Range(priceRange).FormatConditions.Add Type:=1, Operator:=2, Formula1:="=$I$"&finalRowNum + 1&"", Formula2:="=$J$"&finalRowNum + 1&""
objWorkSheet.Range(priceRange).FormatConditions(objExcel.Selection.FormatConditions.Count).SetFirstPriority
objWorkSheet.Range(priceRange).FormatConditions(1).Interior.PatternColorIndex = -4105
objWorkSheet.Range(priceRange).FormatConditions(1).Interior.Color = 255
objWorkSheet.Range(priceRange).FormatConditions(1).Interior.TintAndShade = 0
objWorkSheet.Range(priceRange).FormatConditions(1).StopIfTrue = False
I need it to apply the conditional formatting to the a specific cell (the one I defined as priceRange)
Untested:
Dim rng, fc, rowNum, finalRowNum, objWorkSheet
'...
'...
Set rng = objWorkSheet.Range("K" & rowNum + 2)
'vbscript doesn't support named arguments, only positional
Set fc = rng.FormatConditions.Add(1, 2, _
"=$I$" & finalRowNum, _
"=$J$" & finalRowNum)
fc.SetFirstPriority
With fc.Interior
.PatternColorIndex = -4105
.Color = 255
.TintAndShade = 0
End With
fc.StopIfTrue = False
Related
I am trying to highlight top 2 values for each row for visible cells only using conditional formatting in Excel macro. My range is dynamic, hence I am running a loop to arrive at the last cell of the range.
Here is my code:
With Sheets("pcSupplyChainAnalysis").Select
For i = 2 To ctr
Set rng = Range("C" & i & ":" & "I" & i).SpecialCells(xlCellTypeVisible)
rng.FormatConditions.AddTop10
rng.FormatConditions(rng.FormatConditions.Count).SetFirstPriority
With rng.FormatConditions(1)
.TopBottom = xlTop10Top
.Rank = 2
.Percent = False
End With
With rng.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
rng.FormatConditions(1).StopIfTrue = False
Next
End With
Ctr is a counter I am running to find the position of the last non blank cell, as my data has blank values too and I am copying it from another sheet using macro.
ctr = 2
Do While (ActiveSheet.Range("A" & ctr).Value <> "")
ctr = ctr + 1
Loop
ctr = ctr - 1
ActiveSheet.Range("B2:I" & ctr).Select
Selection.Cut
Range("C2:J" & ctr).Select
ActiveSheet.Paste
Attached is the image of the format of my data. I want to highlight top 2 numbers for each row and ONLY FOR VISIBLE CELLS (as I am using some filters also in the range).
Try this:
Option Explicit
Public Sub ShowTop2()
Dim rng As Range, visibleRow As Range
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("pcSupplyChainAnalysis")
.Columns.FormatConditions.Delete
Set rng = .UsedRange.SpecialCells(xlCellTypeVisible)
End With
For Each visibleRow In rng.Rows
If visibleRow.Row > 1 Then
With visibleRow.FormatConditions
.AddTop10
.Item(.Count).SetFirstPriority
With .Item(1)
.TopBottom = xlTop10Top
.Rank = 2
.Interior.Color = 255
End With
End With
End If
Next
Application.ScreenUpdating = True
End Sub
An easier way to determine the last used row in column A:
ctr = Worksheets("pcSupplyChainAnalysis").Cells(Rows.Count, "A").End(xlUp).Row
You don't need to Select anything for any of your actions
I am trying to conditionally format for each row in a loop skipping every other row. It starts out by formatting range B8:Y8 using a color scale criteria in cell AD8. The next loop should format B10:Y10 using AD10, then B12:Y12 using AD12, etc. all the way to row 98. Here is the formatting code that will be inside the loop:
Range("B8:Y8").Select
Selection.FormatConditions.AddColorScale ColorScaleType:=2
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
xlConditionValueNumber
Selection.FormatConditions(1).ColorScaleCriteria(1).Value = 0
With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
xlConditionValueNumber
Selection.FormatConditions(1).ColorScaleCriteria(2).Value = "=$AD$8"
With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0
End With
It may be expedient to make the conditional formatting rule for B8:Y92 then delete the CFR from the odd rows.
Dim r As Long
With ActiveSheet
With .Range("B8:Y92")
.FormatConditions.Delete
.FormatConditions.AddColorScale ColorScaleType:=2
.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
.FormatConditions(1).ColorScaleCriteria(1).Type = _
xlConditionValueNumber
.FormatConditions(1).ColorScaleCriteria(1).Value = 0
With .FormatConditions(1).ColorScaleCriteria(1).FormatColor
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
.FormatConditions(1).ColorScaleCriteria(2).Type = _
xlConditionValueNumber
.FormatConditions(1).ColorScaleCriteria(2).Value = "=$AD$8"
With .FormatConditions(1).ColorScaleCriteria(2).FormatColor
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0
End With
End With
For r = 9 To 91 Step 2
.Range("B" & r & ":Y" & r).FormatConditions.Delete
Next r
End With
See How to avoid using Select in Excel VBA macros.
I'm trying to add conditional formatting to a range that checks cell X1 and if it doesn't match it applies the conditions.
If i apply it to one cell it works great. however i need it applied to each cell in a range.
code:
Function FindComment(rng As Range, strSearch As String) As Boolean
On Error GoTo err_h:
strSearch = LCase(strSearch)
If Len(strSearch) = 0 Then
FindComment = False
Exit Function
End If
If InStr(1, rng.Comment.Text, strSearch, vbTextCompare) > 0 Or InStr(1, rng.Text, strSearch, vbTextCompare) > 0 Then
FindComment = False
Exit Function
End If
FindComment = True
Exit Function
err_h:
FindComment = True
End Function
And to apply the conditional formatting:
Public Sub AddConditionalFormat(rng As Range)
rng.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=FINDCOMMENT(" & rng.Address(, , xlA1) & ",$X$1)"
rng.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.ColorIndex = 2
End With
With rng.FormatConditions(1).Interior
.Pattern = xlGray75
.PatternThemeColor = xlThemeColorDark2
.PatternTintAndShade = 0
.ColorIndex = 2
.TintAndShade = 0
.PatternTintAndShade = 0
End With
rng.FormatConditions(1).StopIfTrue = False
End Sub
the range range("B6:GD9") are determined as rng.
currently if the results match it just blanks out all cells including the match.
anyone have an idea of how to easily fix? i'd prefer something that would not lag out the code by applying to each cell etc.
The Range.Address property defaults to absolute row and column references. You are looking for something like A1 but you are getting $A$1.
rng.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=FINDCOMMENT(" & rng.Cells(1, 1).Address(RowAbsolute:=False, ColumnAbsolute:=False, ReferenceStyle:=xlA1) & ", $X$1)"
'alternate in shorthand
rng.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=FINDCOMMENT(" & rng.Cells(1, 1).Address(0, 0, xlA1) & ", $X$1)"
Using .Cells(1, 1) should make that formula reference the upper left cell in rng.
In an excel file, I need to color code a column cell depending upon the number of "Yes" in that Column. If there are no "Yes" : Red color; one "Yes": Yellow color: 2 or more than 2 "Yes": Green color.
Can this be done by some macro ?
Update:
Have made this macro but i am not able to run or debug it as it gives an error of Overflow;
The variable N is taking a value of 32676 even after I have assigned it zero value .
Sub testcolor()
Dim i As Integer
Dim j As Integer
Dim N As Integer
Dim z As Integer
Dim val As String
i = 7
j = 5
N = 0
MsgBox (N)
For j = 5 To 15
Do While i < 13
val = ActiveSheet.Cells(i, j).Value
If val = "Yes" Then N = N + 1
Loop
If N = 0 Then
Range(i + 2, j).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
If N = 1 Then
Range(i + 2, j).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
If N > 1 Then
Range(i + 2, j).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next j
End Sub
Another way to solve this is by using Conditional Formatting.
Select the area you wish to format. Looks like it's range E14:K14 in your book.
Click Home > Conditional Formatting > New Rule.
In the New Formatting Rule dialog box, click "Use a formula to determine which cells to format".
Under "Format values where this formula is true", type the following formula:
=AND(E14="Yes",COUNTIF(E:E,"Yes")>=2,ROW()>=7,ROW()<=13)
Next, click the "Format" button.
Now, simply choose the design you wish. Perhaps a colored background is enough.
The GREEN formula is done, but you have to repeat these steps for the yellow and red formulas.
The yellow formula:
=AND(E14="Yes",COUNTIF(E:E,"Yes")<2;COUNTIF(E:E,"Yes")>0,ROW()>=7,ROW()<=13)
And the red formula:
=AND(E14="Yes",COUNTIF(E:E,"Yes")=0,ROW()>=7,ROW()<=13)
Don't forget to apply your format conditions (green/yellow/red background).
Let me break the GREEN formula down for you:
AND() - All of the conditions in between these () brackets need to be met.
E14="Yes" - The cell has to contain the word "Yes".
COUNTIF(E:E,"Yes")>=2 - The column must have 2 or more "Yes".
ROW()>=7,ROW()<=13) - The cell has to be somewhere in between rows 7 to 13.
It's quite easy to change these parameters whenever you need to. And perhaps it's easier than jumping into a big chunk of code. It may look quite difficult using Conditional Formatting with multiple conditions, but once you get a hang of it you won't stop using it.
Try this (set RGB and ColorIndex accordingly, did not get if you want cell text color or fill color):
Sub ConditionalColorColumn()
count = Application.WorksheetFunction.CountIf(arg1:=Range("D:D"), arg2:="yes")
'MsgBox count
If count = 1 Then
ActiveSheet.Range("D:D").Font.Color = RGB(255, 255, 0)
ActiveSheet.Range("D:D").Interior.ColorIndex = 6
ElseIf count >= 2 Then
ActiveSheet.Range("D:D").Font.Color = RGB(255, 255, 0)
ActiveSheet.Range("D:D").Interior.ColorIndex = 6
Else
ActiveSheet.Range("D:D").Font.Color = RGB(255, 255, 0)
ActiveSheet.Range("D:D").Interior.ColorIndex = 6
End If
End Sub
APPENDED: you can try this for multiple columns
Sub ConditionalColorMultiColumn()
'Dim arr As Variant
'Dim desCell As Range
arr = Array("E", "F", "G", "H", "I","J","K")
For i = 0 To UBound(arr)
Set rngg = Range(arr(i) & 7 & ":" & arr(i) & 12)
'rngg.Select
Set desCell = Cells(14, arr(i))
Count = Application.WorksheetFunction.CountIf(arg1:=rngg, arg2:="yes")
'MsgBox count
If Count = 1 Then
desCell.Interior.ColorIndex = 6
ElseIf Count >= 2 Then
desCell.Interior.ColorIndex = 4
Else: desCell.Interior.ColorIndex = 3
End If
Set desCell = Nothing
Set rngg = Nothing
Next
End Sub
I want to loop through 5 cells, Q5 - U5.
With each cell I want to check if the value is equal to "Y", and if yes, highlight the cell to make it green.
How may I do so? Can't seem to figure it out.
For Each c In Range("Q5:U5").Cells
c.Select
If c.Value = Y Then
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5287936
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next
You should try to avoid selecting/activating ranges: in 99% of cases there is no need (although the macro recorder always suggests otherwise)
For Each c In ActiveSheet.Range("Q5:U5").Cells
If c.Value = "Y" Then
With c.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5287936
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next
When you don't define c as a range, the statement
For Each c in ActiveSheet.Range("Q5:U5").Cells
while valid, will actually result in c having the value of each of the cells. To solve this problem, declare the type explicitly:
Dim c as Range
Next, when you do the comparison (as already pointed out), use
If c.Value = "Y"
Note - if you declare
Option Compare Text
right at the top of your module, the comparison will be case-insensitive; otherwise, a "Y" will not match a "y".
The whole module would look like this, then:
Option Explicit
Option Compare Text
Sub colorMe()
Dim c as Range
For Each c In Range("Q5:U5").Cells
c.Select
If c.Value = "Y" Then
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5287936
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next
End Sub
I am sure it doesn't need to be pointed out that you could achieve the same thing with conditional formatting...
In your code, Y appears to be an undefined variable. To check for the value, put it in double quotes:
If c.Value = "Y" Then