We help IT Professionals succeed at work.

Conditionally format row based on input cell

High Priority
48 Views
Last Modified: 2020-03-27
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 With

End Sub

Open in new window

PLTest.XLSX
Comment
Watch Question

CERTIFIED EXPERT

Commented:
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 Double
Dim xpnce As Double
Dim nval As Double
Dim nprcnt As Double
Dim myCell As Range

LastRow = Cells(Rows.Count, 3).End(xlUp).Row
   
xpnce = 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 With
Else
    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 With
End If

For 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 If
Next myCell
   
End Sub
Sub CF_Var2()
Dim LastRow As Double
Dim xpnce As Double
Dim nval As Double
Dim nprcnt As Double
Dim myCell As Range

LastRow = Cells(Rows.Count, 3).End(xlUp).Row
   
xpnce = 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 With
Else
    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 With
End 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, vbOKOnly


End Sub

Paul

Author

Commented:
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

Author

Commented:
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

CERTIFIED EXPERT
Commented:
I'm sorry. When I copied the code I did not realize I also copied a second macro I was trying. Disregard macro "Sub CF_Var2() ". Macro Sub CF_Var() addresses the values in F2 and G2. It then checks all the cells in column C and if the value starts with "Total", it highlights that entire row yellow. It does this until it reaches the last occupied cell in column C. When I run Sub CF_Var2() on the workbook you attached, it highlights rows 12, 19, 27, 34 and 41. I wasn't quite sure what you were looking for in part 2 of your request - Account Line???

Author

Commented:
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

Author

Commented:
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

Dim cr As Long
cr = ActiveCell.Row

    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
 "=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))"



CERTIFIED EXPERT

Commented:
Great! I'm happy this worked for you. Thanks!