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
Related
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.
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
I have attempted various iterations of the below and some have worked first time around, then not after, some not at all.
In short cell b2 on all sheets can be one of 6 text entries, (complete, in progress, scrapped, future works, parked, held) to show the currwnt state of that specific piece of work. To further help at a glance I want to update tab colours based on b1 as well.i.e if in progress B2 goes green, so does that tab.
Current code:
Private Sub tabcolour_Change(ByVal Target As Range)
Select Case Range("$b$2").Value
Case "In progress"
.Color = 43
Case "Held"
.Color = 6
Case "Scrapped"
.Color = 3
Case "Parked"
.Color = 28
Case "Complete"
.Color = 55
Case "Future Works"
.Color = 53
Case Else
.ColorIndex = xlColorIndexNone
End Select
End With
End Sub
I updated it slightly as still not working. The article I used below.
Excel VBA: automatically adjust tab colour
It won't be seen as a macro whilst I have "ByVal Target As Range" between () on the first line. But if I remove it it doesn't work.
It did work correctly once but then didn't change the colour of the cell after and threw up an error (this was a couple of hours ago now, so can't remember the message sorry).
It is probably something very basic, but alas so is my knowledge.
Could someone point me in the right direction please?.
**************EDIT/UPDATE**********************
Current code courtesy of Darren:
Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("B1"), Target) Is Nothing Then
With ActiveSheet.Tab
Select Case Target
Case "In Progress"
.Color = RGB(153, 204, 0)
Case "Held"
.Color = RGB(255, 255, 0)
Case "Parked"
.Color = RGB(0, 255, 255)
Case "Complete"
.Color = RGB(128, 0, 128)
Case "Future works"
.Color = RGB(153, 0, 167)
Case "scrapped"
.Color = RGB(194, 24, 7)
Case Else
.ColorIndex = xlColorIndexNone
End Select
End With
End If
End Sub
The tab colours do change, but not for "In Progress", "Future works", or "scrapped", the rest work fine?. I have changed the RGB values incase it is those colours, but it's still the same?. No colour values make these change, and the text going into the box is right as I have now added this as a data validation too (using a list on another tab). I complete the drop down now, and for 3 of the 6 it works fine???.
Two ways to do it - both use the Change event to monitor when a value is updated on a worksheet.
The Intersect command checks that the range B2 is being changed.
You can either add this code to each sheet:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("B2"), Target) Is Nothing Then
With Target.Parent.Tab
Select Case Target
Case "In Progress"
.Color = 43
Case "Held"
.Color = 6
Case "Parked"
.Color = 28
Case Else
.ColorIndex = xlColorIndexNone
End Select
End With
End If
End Sub
or you can add this code to the ThisWorkbook module:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Sh.Range("B2"), Target) Is Nothing Then
With Sh.Tab
Select Case Target
Case "In Progress"
.Color = 43
Case "Held"
.Color = 6
Case "Parked"
.Color = 28
Case Else
.ColorIndex = xlColorIndexNone
End Select
End With
End If
End Sub
Try
Private Sub worksheet_Change(ByVal Target As Range)
Dim myTab As Object
Set myTab = ActiveSheet.Tab
With myTab
Select Case Range("$b$2").Value
Case "In progress"
.ColorIndex = 43
Case "Held"
.ColorIndex = 6
Case "Scrapped"
.ColorIndex = 3
Case "Parked"
.ColorIndex = 28
Case "Complete"
.ColorIndex = 55
Case "Future Works"
.ColorIndex = 53
Case Else
.ColorIndex = xlColorIndexNone
End Select
End With
End Sub
I'm working on a excel document being generated with APACHE POI.
The document is filled with many drop down lists for data validation.
The data chosen in those drop down lists are always of the same type:
LABEL (ID)
For the person who fills the excel document, the ID is less important than the LABEL _ but the ID is still necessary for parsing purposes.
I managed through APACHE POI to put a specific format on those kind of cells, in order to help the user to focus on the information more useful to him/her :
LABEL is in black
(ID) is in grey
My problem: when the user change a value in the cell throught the drop down list, the style format is lost on the cell.
My question: is it possible to set up a listener on my excel document that does the folowing job:
on ANY cell
filled through ANY drop down list
on ANY sheet of the workbook
set the specified cell format ?
I already have a function that does the "style format" job, but I don't know how to plug it on this kind of listener...
Function formatStyle()
Dim cellContent As String
Dim valeurLength As Integer
For Each currentCell In Selection.Cells
cellContent = currentCell.Value
For valeurLength = 1 To Len(cellContent)
If Mid(cellContent, valeurLength, 1) = "(" Then
Exit For
End If
Next valeurLength
With currentCell.Characters(Start:=1, Length:=valeurLength - 1).Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
With currentCell.Characters(Start:=valeurLength, Length:=Len(cellContent) - valeurLength + 1).Font
.ThemeColor = xlThemeColorDark1
.Color = -4144960
End With
Next
End Function
Excel Form controls don't support any kind of font and color formatting. ActiveX controls let you change the font and colors, but not of individual characters. Custom drawing parts of the control most likely can be achieved with some complicated VBA and WinAPI calls.
The closest alternative I can think of is some of the bold extended Unicode characters:
Thanks to Determine if cell contains data validation, I've managed to do exactly what I wanted:
Private Sub Workbook_SheetChange(ByVal Sh As Object,ByVal Target As Range)
Dim cell As Range, v As Long
For Each cell In Selection.Cells
v = 0
On Error Resume Next
v = cell.SpecialCells(xlCellTypeSameValidation).Count
On Error GoTo 0
If v <> 0 Then
formatReferenceCell (Target)
End If
Next
End Sub
Function formatReferenceCell(cellContent)
Dim X As Integer
For X = 1 To Len(cellContent)
If Mid(cellContent, X, 1) = "(" Then
Exit For
End If
Next X
With ActiveCell.Characters(Start:=1, Length:=X - 1).Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
With ActiveCell.Characters(Start:=X, Length:=Len(cellContent) - X + 1).Font
.ThemeColor = xlThemeColorDark1
.Color = -4144960
End With
End Function