Here's what I've got at the moment:
'Highlight If N=19 & R=OR
Range("G4:R1000").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$N4=19"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = True
I am trying to highlight a few cells based on multiple criteria. If N=19 and if R=OR. I can only get the N=19 portion to work.
I believe the formula adjustment I made in comments above should solve your problem but here is how I clean up recorded Conditional Formatting code.
With Worksheets("Sheet1")
With .Range("G4:R1000")
With .FormatConditions.Add(Type:=xlExpression, Formula1:="=AND($N4=19, $R4=""OR"")")
With .Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
.SetFirstPriority
End With
.FormatConditions(1).StopIfTrue = True
End With
End With
Removing the verbose qualifying code (e.g. Selection.FormatConditions(Selection.FormatConditions.Count)...) makes it much more readable.
Related
I'm an excel vba noob and I'm quite stuck at this code wherein I need to format cells containing a specific criteria for multiple columns.
For example I would need to highlight all values except the cells which contains "Complete" into YELLOW with BOLD RED FONT.
I've tried to just record it by simply filtering out "Complete" and highlighting all other values but I would need it to be dynamic.
Sub Macro1()
ActiveSheet.Range("$A$1:$W$6114").AutoFilter Field:=6, Criteria1:= _
"=Incomplete", Operator:=xlOr, Criteria2:="="
Range("F171").Select
Range(Selection, Selection.End(xlDown)).Select
Range("F171:F6114").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
Selection.Font.Bold = True
End Sub
Will be grateful for any assistance!
Try this:
Sub Macro1()
Dim rng As Range
Set rng = ActiveSheet.Range("A1").CurrentRegion
With rng
.AutoFilter Field:=6, Criteria1:="<>Complete", Operator:=xlAnd
End With
With rng.Range(Cells(2, 6), Cells(rng.Rows.Count, 6)).SpecialCells(xlCellTypeVisible)
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = vbYellow
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With .Font
.Color = vbRed
.TintAndShade = 0
.Bold = True
End With
End With
End Sub
my first button (Schaltfläche 83)
Other button which I want to activate vom "Hirata Bestellformular"
1st option: the top blue one
2nd option: the big one (activexelement)
I want to activate one button from another worksheet because I want to execute the code below on the worksheet "Teileliste" directly from "Hirata Bestellformular". How can I accomplish this?
Sub Teileliste_generieren()
' advanced filter
Sheets("Hirata Bestellformular").Range("Tabelle3[[#Headers],[#Data]]"). _
AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("B50:B51"), _
CopyToRange:=Range("B54:B55"), Unique:=False
Range("B5").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(LEFT(R[50]C,FIND(CHAR(10),R[50]C)-1),R[50]C)"
Range("B6").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(LEFT(R[50]C,FIND(CHAR(10),R[50]C)-1),R[50]C)"
Range("B5:B6").Select
Selection.AutoFill Destination:=Range("B5:B26"), Type:=xlFillDefault
Range("B5:B26").Select
Range("D22").Select
'formatierung tabelle
Range("B3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16763955
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("B4").Select
With Selection.Interior
.Pattern = xlSolid
.PatternThemeColor = xlThemeColorAccent3
.Color = 16777215
.TintAndShade = 0
.PatternTintAndShade = 0.799981688894314
End With
Range("B5").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 9868950
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("B6").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15395562
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("B5:B6").Select
Selection.AutoFill Destination:=Range("B5:B26"), Type:=xlFillDefault
Range("B5:B26").Select
Range("D20").Select
' Wenn 0 blank
Range("B5:B26").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("C22").Select
' Exportieren
ThisWorkbook.Sheets("Teileliste").Copy
Application.GetSaveAsFilename
End Sub
I can try. :)
If I understand you, you want to be able to press Teileliste generieren from Hirata Bestellformular. This means that you still want the button Schaltfläche 83 do to the same thing as Teileliste generieren, but you don't want to switch sheets to press the button?
Then I believe your problem is in your Range.Select statements.
In Excels VBA Object Model, if you call Range("B50:B51").Select from the Teileliste-sheet, then it will automatically select that range in Teileliste-sheet. If do it from Hirata Bestellformular, then it will select Range("B50:B51") from Hirata Bestellformular instead.
This means: it should work if you change all your Range("...").Select to Worksheets("Teileliste").Range("...").Select
This has to do with the Excel VBA Object Model.
I'm pretty sure that should do the trick but it depends on where your code is placed (within the specific sheets or in a Module). Try replacing the Range.Selects and see if it helps. :)
Just A quick hint:
You can right-click the button Schaltfläche 83 and assign a macro to it. So in your case you can just right-click -> assign macro -> choose
Teileliste_generieren()
If your code can deal with being called on different sheets, then it Will work.
//from My iPhone
Sub Teileliste_generieren2()
' advanced filter
Sheets("Hirata Bestellformular").Range("Tabelle3[[#Headers],[#Data]]"). _
AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Worksheets("Teileliste").Range("B50:B51"), _
CopyToRange:=Worksheets("Teileliste").Range("B54:B55"), Unique:=False
Worksheets("Teileliste").Range("B5").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(LEFT(R[50]C,FIND(CHAR(10),R[50]C)-1),R[50]C)"
Worksheets("Teileliste").Range("B6").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(LEFT(R[50]C,FIND(CHAR(10),R[50]C)-1),R[50]C)"
Worksheets("Teileliste").Range("B5:B6").Select
Selection.AutoFill Destination:=Worksheets("Teileliste").Range("B5:B26"), Type:=xlFillDefault
Worksheets("Teileliste").Range("B5:B26").Select
Worksheets("Teileliste").Range("D22").Select
'formatierung tabelle
Worksheets("Teileliste").Range("B5").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark2
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Worksheets("Teileliste").Range("B6").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent4
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Worksheets("Teileliste").Range("B5:B6").Select
Selection.AutoFill Destination:=Worksheets("Teileliste").Range("B5:B26"), Type:=xlFillDefault
Worksheets("Teileliste").Range("B5:B26").Select
Worksheets("Teileliste").Range("C18").Select
' Wenn 0 blank
Worksheets("Teileliste").Range("B5:B26").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Worksheets("Teileliste").Range("C22").Select
' Exportieren
ThisWorkbook.Sheets("Teileliste").Copy
Application.GetSaveAsFilename
End Sub
I just replaced it everywhere like you said and it works if I aktivate the makro from "Teileliste" but there s error when I acctivate it from "Hiraa Bestellformular" saying: Error1004 he Select- Method of the Range-Object could not be executed:/ Another suggestion?:)
I am extremely new to VBA world and need some assistance with the VBA side of conditional formatting.
1) I need conditional formatting to be applied to column (M)
green under 7
yellow from 7-20
red greater than 20
With the overriding condition that if column (N) if it states NOPO, I do not want conditional formatting to be applied.
I have worked out a formula to use that indicates what colour is required but unable to turn that into VBA conditional formatting (this formula shows what colour and if the conditional formatting should be applied.
=IF(N2="osno",IF(M2<=7,"green",IF(M2<7,IF(M2>20,"red","less than 20"),IF(M2>20,IF(M2>20,"red","less than 20"),"yellow"))),"no format")
This is my current VBA script, as you can no doubt see it's very messy and was from a recorded script.
Sub Conditional()
'
' Notification_05 Macro
' Conditional Formatting
'
'
Sheets("Final").Select
Columns("M:M").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:="=8"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=8", Formula2:="=20"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=20"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 470000
.TintAndShade = 0
ActiveWindow.SmallScroll Down:=-27
Range("M2").Select
With Range("M:M")
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=LEN(TRIM(M1))=0"
With .FormatConditions(.FormatConditions.Count)
.SetFirstPriority
End With
End With
End With
End Sub
Thanks,
Blake
A CF formula needs to return either true or false: you can't use a single formula to assign one of multiple colors, only to decide if a color should be applied or not. You will need three rules, each with a slightly different formula.
Sub Tester()
Dim rng As Range
Set rng = Selection
rng.FormatConditions.Delete 'clear any existing rules
AddRule rng, "=AND(M2=""osno"", N2<7)", vbGreen
AddRule rng, "=AND(M2=""osno"", N2>=7,N2<=20)", vbYellow
AddRule rng, "=AND(M2=""osno"", N2>20)", vbRed
End Sub
'utility sub: add a CF rule given the formula and a fill color
Sub AddRule(rng, sFormula, lColor)
With Selection.FormatConditions
With .Add(Type:=xlExpression, Formula1:=sFormula)
.Interior.Color = lColor
.StopIfTrue = True
End With
End With
End Sub
I have a dataset in which each row belongs to a unique person so what I want to do is that find duplicate values in each row.
I tried using conditional formatting but its very time consuming as I have to apply it to each individual row otherwise it will find duplicates among all rows not just one row.
Could you please suggest something that can help me it can be formula or vba or formula for conditional formatting.
I used macro recorder to create a macro and the results is below. If I can make it go through a range of rows and apply the formatting that could help
Sub DuplicatesRow1() ' ' DuplicatesRow Macro '
'
Rows("251:251").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
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
Rows("252:252").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
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
Rows("253:253").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
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
Range("E259").Select End Sub
I further worked on this and managed to come up with the following code which seems to be working for me. I am new to VBA and do not have enough experience so please let me know if my code can be improved further
Private Sub HighlightDuplicateRow(row As Integer)
Dim report As Worksheet
Set report = Excel.ActiveSheet
report.Cells(row, row).EntireRow.Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
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
Sub DuplicatesInEachRow()
Dim counter As Integer, limit As Variant
counter = 2
limit = InputBox("Give me last row number", "Highlight Duplicates in a Row")
If limit = "" Then Exit Sub
Do Until counter > limit
Call HighlightDuplicateRow(counter)
counter = counter + 1
Loop
End Sub
Here is a loop that will set a conditional format on each row. I used sheet and range references based on your sample data and code. You modify these to fit your exact data set.
I will also note that I am concerned about this causing performance issues in Excel if there are numerous rows, as the amount of Formats may seriously raise your file size and affect performance.
Sub LoopCF()
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
'Dim lRow As Long
'lRow = ws.Range("A2").End(xlDown).Row 'will give row 200 as long as contiguous rows
Dim rng As Range, cel As Range
Set rng = ws.Range("B2:B200") 'ws.Range("B2:B" & lRow)
For Each cel In rng
With cel.Resize(1, 4)
.FormatConditions.AddUniqueValues
.FormatConditions(.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1)
.DupeUnique = xlDuplicate
With .Font
.Color = -16383844
.TintAndShade = 0
End With
With .Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With
.StopIfTrue = False
End With
End With
Next
End Sub
I'm creating an Excel document at runtime that has a bunch of values I'd like to have conditionally formatted. In going through various attempts from scratch as well as using/modifying code outputted from the Excel's macro recorder, I'm having a consistent issue related to formatting overwrites.
I've posted a snippet of the code below and can say that I've tested to ensure my selection ranges are valid and appropriate for what I want conditionally formatted. There is some overlap but what's bizarre is that the first conditional format takes on just one property of the second conditional format. Meaning D5:End of the worksheet ends up having a green color font as opposed to the red it should be. Commenting each section of the code does allow them to work independently but I'm guessing this is an issue with specifying conditional formats further somehow? I've tried a few different case scenarios and below is the code with modifications:
EDIT (Updated Code):
'First conditional format, check sheet for values > 50 and make text red.
With xl.range("D5:" & theLastColumn & lastRow)
.FormatConditions.add Type:=xlCellValue, Operator:=xlGreater, Formula1:="=50"
With .FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
'Second conditional format, check specific row (row 5 in the example)
'for values > 40, and fill interior with green in addition to dark green text.
With xl.range("D" & Infectivity & ":" & theLastColumn & Infectivity)
.FormatConditions.add Type:=xlCellValue, Operator:=xlGreater, Formula1:="=40"
With .FormatConditions(2).Font
.Color = -16752384
.TintAndShade = 0
End With
With .FormatConditions(2).Interior
.PatternColorIndex = xlAutomatic
.Color = 13561798
.TintAndShade = 0
End With
End With
So what's the best way to have multiple conditional formats (that may overlap ranges) and still have them all function as intended? I've tried debugging this so much I'm certain there's something easy I'm overlooking. I've also tried a few different methods to specify separate formatconditions(1) and formatconditions(2) but still receive strange issues.
EDIT:
VBA Code where I continue to have the same issue.
Sub conditionalFormat()
With Range("D5:BA9")
.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:="=50"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
With Range("D9:BA9")
.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:="=40"
With .FormatConditions(2).Font
.Color = -16752384
.TintAndShade = 0
End With
With .FormatConditions(2).Interior
.PatternColorIndex = xlAutomatic
.Color = 13561798
.TintAndShade = 0
End With
.FormatConditions(2).StopIfTrue = False
End With
End Sub
Even with the SetFirstPriority on the appropriate (red text) conditional format, it just gets overwritten somehow. Am I missing something here?
Sorry. I don't have Excel 2007. Tested this in Excel 2010.
When it comes to conditional formatting, you have to be really careful of what the macro recorder spits out. This is one particular case where it makes a mess of the code.
Also you are setting then 2nd rule as .SetFirstPriority which is incorrect besides letting the 2nd rule run in spite of rule 1 get getting satisfied :)
Here is a very basic example. Let's say my range looks like this D5:G7
Now this is the VBA code that I tested
Sub Sample()
Dim ws As Worksheet
Dim rng As Range
Set ws = ThisWorkbook.Sheets("Sheet1")
Set rng = ws.Range("D5:G7")
With rng
.FormatConditions.Add Type:=xlCellValue, _
Operator:=xlGreater, Formula1:="=50"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Font
.Color = -16776961
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = True
.FormatConditions.Add Type:=xlCellValue, _
Operator:=xlGreater, Formula1:="=40"
With .FormatConditions(2).Font
.Color = -11489280
.TintAndShade = 0
End With
With .FormatConditions(2).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.599963377788629
End With
End With
End Sub
And this is the result that I got.
I am sure it will be very easy for you to port the above code to vb6.
FOLOWUP (From Comments)
Using latebinding... would earlybinding be better suited for doing this type of conditional formatting? – Bernard 2 mins ago
If you are using LateBinding then declare this code at the top of your code
Const xlCellValue as Long = 1
Const xlGreater as Long = 5
Const xlAutomatic as Long = -4105
Const xlThemeColorAccent3 as Long = 7
After much thought and reworking the code we came to the conclusion that what I was doing (multiple conditions overlapping) was the cause of the mixed results. At the simplest level, I was able to add .FormatConditions.Delete to my additional conditional formats to ensure only one format was applied.
The corrected final code is shown below:
Dim Infectivity As Long
Infectivity = Application.WorksheetFunction.match("Infectivity", range("A1:" & "A" & lastRow), 0)
With xl.range("D5:" & theLastColumn & lastRow)
.FormatConditions.add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=50"
.FormatConditions(.FormatConditions.count).SetFirstPriority
With .FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
If Infectivity > 0 Then
With xl.range("D" & Infectivity & ":" & theLastColumn & Infectivity)
.FormatConditions.Delete
.FormatConditions.add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="=40"
With .FormatConditions(1).Font
.Color = -16752384
.TintAndShade = 0
End With
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13561798
.TintAndShade = 0
End With
.FormatConditions(1).StopIfTrue = False
End With
End If
My downfall was related to the macro recorder giving me a false of the ideal method of formatting these cells. It's always best to simplify before moving forward.
Major thanks to Siddharth Rout for all the help.