Excel VBA Loop Conditional Formatting by Each Row - vba

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.

Related

Conditional formatting in Excel Macro only working on first cell of selection

I'm trying to automate the creation of some pivot tables for a report that I need. I recorded a Macro to make the necessary changes, and it mostly functions correctly, apart from missing the conditional formatting. It works on the top cell of the selection, but that's all.
I'm aware that there has been issues with Macros in Excel and Conditional formatting, but I didn't find any answers to solve this problem. The section of the code that I believe applies to that condition is below.
Range("G6:G13").Select
Selection.FormatConditions.AddColorScale ColorScaleType:=3
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
xlConditionValueLowestValue
With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
.Color = 8109667
.TintAndShade = 0
End With
Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
xlConditionValuePercentile
Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
.Color = 8711167
.TintAndShade = 0
End With
Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
xlConditionValueHighestValue
With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
.Color = 7039480
.TintAndShade = 0
End With
Selection.FormatConditions(1).ScopeType = xlSelectionScope
Range("I6:I13").Select
Selection.FormatConditions.AddColorScale ColorScaleType:=3
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
xlConditionValueLowestValue
With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
.Color = 8109667
.TintAndShade = 0
End With
Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
xlConditionValuePercentile
Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
.Color = 8711167
.TintAndShade = 0
End With
Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
xlConditionValueHighestValue
With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
.Color = 7039480
.TintAndShade = 0
End With
Selection.FormatConditions(1).ScopeType = xlSelectionScope
Current result I'm seeing:
and the desired outcome
Thanks in advance for any help!
Realise this is an old post and can't see any responses.
I had a similar problem, but when I stepped through the macro line by line I found that removing the last line Selection.FormatConditions(1).ScopeType = xlSelectionScope seemed to stop the problem.
I am unsure if there are unforeseen any knock on impacts of removing this yet, but will update if I find any.

VBA applying conditional formatting to cell

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.

Convert VBA code to run in vbscript [duplicate]

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

How to Loop Through 5 Cells in a Row Using Excel VBA

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

Codehelp: Seeking column, and format cells

I have a little problem with my macrocode, and need your advice. Here my base macrocode:
Option Explicit
Sub NurZumUeben()
'oberste Zeile löschen, fixieren und linksbündig ausrichten
Rows("1:1").Select
Selection.Delete Shift:=xlUp
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
'Jede zweite Zeile schattieren
Application.ScreenUpdating = False
Dim Zeile, ZeilenNr As Integer
With ActiveSheet.UsedRange.Rows
.Interior.ColorIndex = xlNone
.Borders.ColorIndex = xlNone
End With
ZeilenNr = 2
For Zeile = 2 To ActiveSheet.UsedRange.Rows.Count
With Rows(Zeile)
If .Hidden = False Then
If ZeilenNr Mod 2 = 0 Then
.Interior.ColorIndex = 15
.Borders.Weight = xlThin
.Borders.ColorIndex = 16
ZeilenNr = ZeilenNr + 1
Else
ZeilenNr = ZeilenNr + 1
End If
End If
End With
Next Zeile
Application.ScreenUpdating = True
'oberste Zeile einfärben
Rows("1:1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'Spalte_suchen&formatieren
Dim iLeSpa As Integer
Dim iSpalte As Integer
Dim bGefunden As Boolean
iLeSpa = IIf(IsEmpty(Cells(1, Columns.Count)), Cells(1, _
Columns.Count).End(xlToLeft).Column, Columns.Count)
For iSpalte = 1 To iLeSpa
If Cells(1, iSpalte).Value = "click_thru_pct" Then
bGefunden = True
Exit For
End If
Next iSpalte
If bGefunden Then
With Range(Cells(2, iSpalte), Cells(5000, iSpalte))
.Replace What:="%", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows
Range("K1") = 100
Range("K1").Copy
.PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide
.NumberFormat = "0.00%"
Range("K1").Clear
End With
Else
MsgBox "Die Überschrift ""click_thru_pct"" wurde nicht gefunden.", _
48, " Hinweis für " & Application.UserName
End If
End Sub
Once thank you all who can help. Unfortunately, I get the final formatting not go quite
Here are the results: example
I did not want to color the entire column but only the top row. In addition, the lower empty fields with ugly 0.00% formatted constantly.
Furthermore, I noticed that after the coloration of the first line, the field K1 is visible. That is with me unfortunately impractical because these Excel documents can also go differently in the row.
Here is the document on which you can test it if necessary.
example
Thank you very much
Change modular function to calculate the for loop variable. I see no purpose in using a separate variable for this. Change this:
ZeilenNr = 2
For Zeile = 2 To ActiveSheet.UsedRange.Rows.Count
With Rows(Zeile)
If .Hidden = False Then
If ZeilenNr Mod 2 = 0 Then
.Interior.ColorIndex = 15
.Borders.Weight = xlThin
.Borders.ColorIndex = 16
ZeilenNr = ZeilenNr + 1
Else
ZeilenNr = ZeilenNr + 1
End If
End If
End With
Next Zeile
To this:
For Zeile = 2 To ActiveSheet.UsedRange.Rows.Count
With Rows(Zeile)
If .Hidden = False Then
If Zeile Mod 2 = 0 Then
.Interior.ColorIndex = 15
.Borders.Weight = xlThin
.Borders.ColorIndex = 16
End If
End If
End With
Next Zeile
I apologize if I am missing something here. Also, I cannot view the examples you provided because the site requires a login and it is not in English. Sorry again.
Within your existing code,
Substitute 5000 with ActiveSheet.UsedRange.Rows.Count
Substitute Range("K1").Clear with Range("K1").ClearContents
Instead of For Zeile = 2 To ActiveSheet.UsedRange.Rows.Count, you could use
For Zeile = 2 To ActiveSheet.Range("A1").CurrentRegion.Rows.Count-1
.UsedRange is not always properly reset. You sample seems a good candidate for .CurrentRegion