I currently have conditional formatting to format a cell red if the number in the cell is greater than the refence cell. I want to add another criteria that will undo the conditional formatting if another cell says Municipal. This is applying to all cells, not just the ones that say municipal.
How do I fix this?
For x = 5 To lastRowPC
If .Cells(x, 3) = "Municipal" Then
With .Range(.Cells(x, 77), .Cells(x, 79)).FormatConditions(1).Font
.Color = 0
.TintAndShade = 0
End With
With .Range(.Cells(x, 77), .Cells(x, 79)).FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = vbWhite
.TintAndShade = 0
End With
End If
Next
This is within a larger macro as well.
Related
I'd like to find the way to duplicate this at the following rows. It has to go from C1:E1 than C2:E2 and so on.
Sub Conditional()
Conditional Macro
Range("C1:E1").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlUnique
With Selection.FormatConditions(1).Font
Color = -16383844
TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
PatternColorIndex = xlAutomatic
Color = 13551615
TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub
I am very new to excel
Thanks in advance
Recommendations
Selects should be replaced; not addressing for color handling in the solution, but you may consider to change to a RGB logic since themes may vary per user and the color may not be the one that you originally intended to. I will think that you need it in 2 different rulings as now (the duplicates in each column and not in the range).
Solution
Sub Exec_Conditional()
Call Conditional(Range("C1:E1"))
Call Conditional(Range("C2:E2"))
End Sub
Sub Conditional(RangeToPerform As Range)
'if you need to have this condition only in the range, otherwise comment the delete line
RangeToPerform.FormatConditions.Delete
RangeToPerform.FormatConditions.AddUniqueValues
RangeToPerform.FormatConditions(RangeToPerform.FormatConditions.Count).SetFirstPriority: RangeToPerform.FormatConditions(1).DupeUnique = xlUnique
With RangeToPerform.FormatConditions(1).Font
.Color = -16383844: .TintAndShade = 0
End With
With RangeToPerform.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic: .Color = 13551615: .TintAndShade = 0
End With
RangeToPerform.FormatConditions(1).StopIfTrue = False
End Sub
I'm trying to use VBA to give conditional formatting to my table, however my code generates error.
The code is:
Range("M236:P240").Select
Selection.FormatConditions.Add Type:=xlExpression, _
Formula1:="=AND(<$M$241, <7)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 192
.TintAndShade = 0
End With
When I run it I get an error 5 in the line:
Formula1:="=AND(<$M$241,<7)"
I think it must be a small mistake, maybe I'm missing some parentheses or some quotation marks.
Why is this error generated?
PD: If I change it for:
Formula1:="=AND(M236<$M$241; M236<7)"
The code run, but nothing happens.
I Solved the problem. I had several errors which I mention below:
Thanks to #Scott Craner who mentioned that the formula should not be Formula1:="=AND(<$M$241, <7)" but (M236<$M$241; M236<7)
Secondly my excel for formulas does not use "," but ";".
My excel is in Spanish, so I shouldn't use "AND" but "Y".
try this macro
Option Explicit
Sub colorize_me()
Dim Rg_To_compaire As Range
Dim My_Rg As Range
Dim Single_Range As Range
Dim My_const As Byte: My_const = 7
Set Rg_To_compaire = Range("M241")
Dim My_min#
My_min = Application.Min(Rg_To_compaire, My_const)
If Not IsNumeric(Rg_To_compaire) Then Exit Sub
Set My_Rg = Range("M236:P240")
For Each Single_Range In My_Rg
If IsNumeric(Single_Range) And Single_Range < My_min Then
Single_Range.Interior.ColorIndex = 6
Else
Single_Range.Interior.ColorIndex = xlNone
End If
Next
End Sub
I am new to VBA and looking to run a code to colour cells in rows in a specific colour. I have been using DO UNTIL and always end with an extra cell coloured. What is the best way to overcome this.
The table I am working with looks like this,
Number/Name
1/test_01
2/test_02
3/test_03
4/test_04
5/test_05
and continues on and the end will change each time i run the code.
I have set up a test sheet to get the basic idea running so I can expand upon it once I have it running properly. This specific test is dividing column A (Number) by 2 and if there is a remainder of 1 then it will be coloured one way and if not it will be coloured another.
Sub Button2_Click()
Dim row_cnt As Integer
row_cnt = 1
Do Until Sheets("sheet1").Range("A" & row_cnt).Value = ""
row_cnt = row_cnt + 1
If Sheets("sheet1").Range("A" & row_cnt).Value Mod 2 <> 0 Then
Range("A" & row_cnt & ":B" & row_cnt).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Else
Range("A" & row_cnt & ":B" & row_cnt).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent4
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
End If
Loop
End Sub
I expect the cells to be coloured until the last cell with a value in. However, this code goes past that and colours an extra cell. I am looking for a way to improve what I have.
you can dynamically find the last row, such that:
lr = cells(rows.count,1).end(xlup).row
row_cnt = 1
Do until row_cnt = lr+1 'so you get actions on your last row
'do stuff
row_cnt = row_cnt + 1
loop
if you can avoid vba for this, bigben's suggestion for conditional formatting would be solid
To answer the specific Q "Why doesn't my Do Untilwork":
It's because you test based on a value of row_cnt , then immediately increment it inside the loop, so process the next row.
To fix that, move the increment to just before Loop and adjust the initialisation of row_cnt
On a side note, you should use Long rather than Integer as the counter data type
My code is checking if cell value from 2 sheets are different, if no it continue check for next row, if different it copy from sheet2 to sheet1 the cell value where I need and add to Cell in sheet1(where the value copied too) a comment with the old value.
every time when the value changed again it remove the comment and put new one.
I need to do a comment check if exist and append the old value to comment.
I want that the comment will contain all the old values that changed in the cell.
this is my piece of code:
If Not IsEmpty(datasheet.Cells(iData, j).Value) Then
comm = user & vbNewLine & "Old Date:" & vbNewLine & ActiveCell.Value
datasheet.Cells(iData, j).Copy Destination:=ActiveCell
With ActiveCell
ActiveCell.Interior.ColorIndex = 0
With ActiveCell.Borders
.LineStyle = xlContinuous 'Setting style of border line
.Weight = xlThin 'Setting weight of border line
.ColorIndex = xlAutomatic 'Setting colour of border line
End With
If Not .Comment Is Nothing Then .Comment.Delete
.ClearComments
.AddComment
.Comment.Text Text:=comm
.Comment.Visible = False
End With
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