Excel 365 Windows 10 VBA Conditional formatting
PLTest.xlsx is small sample with data values changed
Corporate monthly #s tab usually < 1000 rows
place 10000 in F2 10% in G2
format each qualifying row yellow from row2 to last row
Part 1 Is it a total line? If Left(c2,5) = "TOTAL"
Part 2 Is it an account line? isnumber(b2) Account
Macro would run with these default numbers
I would like for the user to be able to change numbers and if necessary rerun the macro
Sub CF_Var()'' Macro1 Macro' Dim Lastrow As String Lastrow = CStr(wksht.Cells(2, "C").End(xlDown).Row) Range("F2").Select ActiveCell.FormulaR1C1 = "10000" Range("G2").Select ActiveCell.FormulaR1C1 = "0.1" Range("G2").Select Selection.NumberFormat = "0.00%" With Selection.Font .Name = "Century Gothic" .FontStyle = "Bold" .Size = 14 End With Range("F2").Select With Selection.Font .Name = "Century Gothic" .FontStyle = "Bold" .Size = 14 End With 'IF left(c27,5) = "Total") start with c2 and check to last row.'NEED LOGIC HERE to check all rows for TOTAL 'Version TWO check if column B is a number Rows("12:12").Select Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ "=OR(AND(ABS($F27)>$F$2,ABS($G27)>$G$2),AND(ABS($J27)>$F$2,ABS($K27)>$G$2),AND(ABS($O27)>$F$2,ABS($P27)>$G$2))" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 End WithEnd Sub
Windows 10Windows OSVBAMicrosoft ExcelMicrosoft Office
Last Comment
Flyster
8/22/2022 - Mon
Flyster
See if this gives you the results you are looking for. It prompts you whether or not to keep the 10000 / 10% values. If not, user can modify those values. It then highlights all rows where column C starts out "Total".
Sub CF_Var()Dim LastRow As DoubleDim xpnce As DoubleDim nval As DoubleDim nprcnt As DoubleDim myCell As RangeLastRow = Cells(Rows.Count, 3).End(xlUp).Rowxpnce = MsgBox("Keep Operating Expenses at 10,000 & 10%?", vbYesNo, "Operating Expenses")If xpnce = 6 Then Range("F2").Value = 10000 Range("G2").Value = 0.1 Range("F2:G2").Select With Selection.Font 'Formatting not needed if it will remain the same .Name = "Century Gothic" .FontStyle = "Bold" .Size = 14 End WithElse nval = InputBox("Enter New Operating Expense Figure", "New Operating Expense Figure") nprcnt = InputBox("Enter New Operating Percent Figure (1-100)", "New Operating Percent Figure") Range("F2").Value = nval Range("G2").Value = nprcnt / 100 Range("F2:G2").Select With Selection.Font .Name = "Century Gothic" .FontStyle = "Bold" .Size = 14 End WithEnd IfFor Each myCell In Range("C9:C" & LastRow) If Left(myCell.Value, 5) = "Total" Then myCell.EntireRow.Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With End IfNext myCellEnd SubSub CF_Var2()Dim LastRow As DoubleDim xpnce As DoubleDim nval As DoubleDim nprcnt As DoubleDim myCell As RangeLastRow = Cells(Rows.Count, 3).End(xlUp).Rowxpnce = MsgBox("Keep Operating Expenses at 10,000 & 10%?", vbYesNo, "Operating Expenses")If xpnce = 6 Then Range("F2").Value = 10000 Range("G2").Value = 0.1 Range("F2:G2").Select With Selection.Font 'Formatting not needed if it will remain the same .Name = "Century Gothic" .FontStyle = "Bold" .Size = 14 End WithElse nval = InputBox("Enter New Operating Expense Figure", "New Operating Expense Figure") nprcnt = InputBox("Enter New Operating Percent Figure (1-100)", "New Operating Percent Figure") Range("F2").Value = nval Range("G2").Value = nprcnt / 100 Range("F2:G2").Select With Selection.Font .Name = "Century Gothic" .FontStyle = "Bold" .Size = 14 End WithEnd If For Each myCell In Range("C9:E" & LastRow) If Left(myCell.Value, 5) = "Total" Then If MrStr <> "" Then MrStr = MrStr & vbCr & myCell.Value & vbTab & Format(Range("D" & myCell.Row).Value, "$0,000") _ & vbTab & vbTab & Format(Range("E" & myCell.Row).Value, "$0,000") Else MrStr = MrStr & vbCr & myCell.Value & vbTab & Format(Range("D" & myCell.Row).Value, "$0,000") _ & vbTab & vbTab & Format(Range("E" & myCell.Row).Value, "$0,000") End If End If Next myCell MsgBox "Account Description Feb-2020 Actual Feb-2020 Budget " & vbCr & MrStr, vbOKOnlyEnd Sub
This logic looks like it is on the right path for what I need for the totals line. You tried to use my last row logic from another simple job, but this table has lots of spaces and is not as simple. Data does not start at $b$2 but instead starts at $B$11
It tries to create a table from $b$2:$g$9 instead of $B$11:$T$224 I manually changed the table creation and it runs
Row 11 gets red filter row named column1 column2 column3 etc First Account line and every other line is pink in each grouping Total lines remain orange except for blanks in B, H, L which turn pink Grey header lines stay grey except for blanks in H and L turn pink
avgplusguy
ASKER
I am trying to figure out where the pink lines and new line 11 comes from so I only put in the top SUB END SUB I step into each line with F8 and every total line turns yellow I stop after it gets to end sub and it looks like expected because it is not testing for conditional formatting. If I click run it gets the strange formatting. I have personal.xlsm open with no macros I have expense template open and this is the only macro I am removing the interaction with the user. If they want to change it they can type over the defaults and then run the macro
For some reason the top macro appears to run repeatedly even if you step through debug mode with F8. It does not stop at END SUB At the very end it goes into design styles and applies table styles colors. I have Office Professional Plus 2016 (turns blue) at home and Office 365 (turns red/pink) at work.
Initial thoughts were to put this in multiple managers personal.xlsm. I then realized that I should send out a template with the macro in it that they can reuse every month and not worry about new worksheets without the macro. Tab2 named chk will have the two variables to check Main tab named report and they can copy over the data every month and save it as the current month
I have commented out the interactive part. If you are located towards the top when you call the macro with Cnrtl+L It shows a data table buile with $B$2:$G$9 which should be $b$9:$t$41 Entire Total line should only be highlighted if any one of three conditions is met current month variance is > f2 (10000) and current month var% > g2 (10%) prior month variance is > f2 (10000) and prior month var% > g2 (10%) current ytd variance is > f2 (10000) and current ytd var% > g2 (10%)
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ "=OR(AND(ABS($F27)>$F$2,ABS($G27)>$G$2),AND(ABS($J27)>$F$2,ABS($K27)>$G$2),AND(ABS($O27)>$F$2,ABS($P27)>$G$2))" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 End With
The static row 27 needs to variable something similar to Dim cr As long cr = ActiveCell.Row when i changed this to "=OR(AND(ABS(F &cr)>$F$2,ABS(G & cr)>$G$2),AND(ABS(J & cr)>$F$2,ABS(K & cr)>$G$2),AND(ABS(O & cr)>$F$2,ABS(P & cr)>$G$2))"
When I hit run yellow boxes primarily in E and F no pattern
avgplusguy
ASKER
Paul, I have over complicated the question Your solution highlights every total line I need the line to highlight the total line if the current total line F value is > $F$2 and G is > $G$2 etc I added and your solution works
Open in new window
Paul