Solved

Excel VBA Conditional Formatting Problem

Posted on 2011-09-28
7
486 Views
Last Modified: 2012-06-22
Hello,

The attached file is from an MS Access export to Excel (Office 2003). I am running into a snag where I want to add conditional formatting to specific cells in a row based on cells in 2 other rows above being unequal (<>). Bascially per the sample workbook, cell D10 needs to turn RED if D7 and D9 are not equal. The issue is the cells for this formula can differ on every run and are created as part of the code.  I do not know how to specify these in conditonal formatting.

The attached workbook shows what the workbook looks like before and after the code is run (no code in the workbook sample).

The code sx below is a portion of the formatting as well as where I am stuck.

Thanks for any help...greatly appreciated!


Sub BalancesforInvPayment() 
     '
     ' Review Payment Balances query export formatting
    Dim LastCol As Long 
    Dim LastRow As Long 
    Dim TotalRow As Long 
    Dim InvVoucher As Long 
    Dim BalRange As Long 
    Application.ScreenUpdating = False 
     
     'set formulas and conditonal formatting
    Range("D2").Select 
    Range(Selection, Selection.End(xlToRight)).Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.FormatConditions.Delete 
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ 
    "=IF(SUM($D2:$E2)<=$C2,TRUE,)" 
    Selection.FormatConditions(1).Interior.ColorIndex = 35 
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ 
    "=IF(SUM($D2:$E2)>=$C2,TRUE,)" 
    With Selection.FormatConditions(2).Font 
        .Bold = True 
        .Italic = False 
    End With 
    Selection.FormatConditions(2).Interior.ColorIndex = 3 
     ' calulate range, set variables
    With ActiveSheet 
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column ' changed .Cells(4, to 1,...
        TotalRow = LastRow + 1 
        InvVoucher = LastRow + 3 
        BalRange = LastRow + 4 
         
         'set lastrow plus "X" for totals row
         'set starting column, then "resize" area where formulas will go _
        by subtracting starting column from total number of columns...work on changing To a variable 
        Cells(TotalRow, "C").Resize(1, LastCol - 2).Select 
        With Selection.Borders(xlEdgeTop) 
            .LineStyle = xlDouble 
            .Weight = xlThick 
            .ColorIndex = xlAutomatic 
        End With 
         
         'in formula set R[- "y"] to row where sum stosp relative to totals row
        Cells(TotalRow, "C").Resize(1, LastCol - 2).FormulaR1C1 = "=sum(R2C:R[-1]C)" 
         
         'format the last row to bold
        Cells(TotalRow, "C").Resize(1, LastCol - 2).Font.Bold = True 
         'Cells(.Rows.Count, 1).End(xlUp).Resize(1, LastCol).Font.Bold = True
         
         'set target voucher cells
        Cells(InvVoucher, "D").Resize(1, LastCol - 3).Select 
        With Selection.Borders 
            .LineStyle = xlContinuous 
            .Weight = xlMedium 
            .ColorIndex = xlAutomatic 
        End With 
        With Selection.Borders(xlInsideVertical) 
            .LineStyle = xlNone 
        End With 
        With Selection.Borders(xlInsideHorizontal) 
            .LineStyle = xlNone 
        End With 
         
         
        Cells(TotalRow, "C").Value = "TOTALS" 
        Cells(InvVoucher, "C").Value = "Enter Invoice Target $" 
        Cells(InvVoucher, "C").Select 
        Selection.Font.Bold = True 
        Selection.HorizontalAlignment = xlRight 
        Cells(BalRange, "C").Value = "Balance" 
        Cells(BalRange, "C").Select 
        Selection.Font.Bold = True 
        Selection.HorizontalAlignment = xlRight 
         
         
         
' Need this section to format based on comparison that cells in same column above in TOTALS row and INVVOUCHER row are <>
        Cells(BalRange, "D").Resize(1, LastCol - 3).Select 
        With Selection 
            .FormatConditions.Delete 
             '            .FormatConditions.Add Type:=xlExpression, Formula1:= _
             'need formula here                "=IF(   TR<>IT,       TRUE,)"
             '            .FormatConditions(1).Interior.ColorIndex = 3
        End With 
    End With 
    Application.ScreenUpdating = True 
    Range("A2").Select 
End Sub

Open in new window

invpymnts.xls
0
Comment
Question by:matttclark
7 Comments
 
LVL 5

Expert Comment

by:Kannan253984
ID: 36717800
Hi,

Instead of writing thru VBA, you can do thru Conditional formatiing option itself.

Please refer the image and excel sheet.

KK,
ConditionalFormat.png
ConditionalFormat.xlsx
0
 
LVL 24

Accepted Solution

by:
StephenJR earned 500 total points
ID: 36717812
If the cells are always in the same place relative to "Totals", perhaps this?
Dim r As Long
    
r = Columns(3).Find(what:="totals", lookat:=xlWhole, MatchCase:=False).Row

With Range("D" & r + 3).Resize(, 2)
    .FormatConditions.Delete
    .FormatConditions.Add Type:=xlExpression, Formula1:="=D" & r & "<>D" & r + 2
    .FormatConditions(1).Interior.ColorIndex = 3
End With

Open in new window

0
 
LVL 17

Expert Comment

by:andrewssd3
ID: 36717817
I think this code does what you want:
Sub BalancesforInvPayment()
     '
     ' Review Payment Balances query export formatting
    Dim LastCol As Long
    Dim LastRow As Long
    Dim TotalRow As Long
    Dim InvVoucher As Long
    Dim BalRange As Long
    Application.ScreenUpdating = False
     
     'set formulas and conditonal formatting
    Range("D2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FormatConditions.Delete
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
    "=IF(SUM($D2:$E2)<=$C2,TRUE,)"
    Selection.FormatConditions(1).Interior.ColorIndex = 35
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
    "=IF(SUM($D2:$E2)>=$C2,TRUE,)"
    With Selection.FormatConditions(2).Font
        .Bold = True
        .Italic = False
    End With
    Selection.FormatConditions(2).Interior.ColorIndex = 3
     ' calulate range, set variables
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column ' changed .Cells(4, to 1,...
        TotalRow = LastRow + 1
        InvVoucher = LastRow + 3
        BalRange = LastRow + 4
         
         'set lastrow plus "X" for totals row
         'set starting column, then "resize" area where formulas will go _
        by subtracting starting column from total number of columns...work on changing To a variable
        Cells(TotalRow, "C").Resize(1, LastCol - 2).Select
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlDouble
            .Weight = xlThick
            .ColorIndex = xlAutomatic
        End With

         'in formula set R[- "y"] to row where sum stosp relative to totals row
        Cells(TotalRow, "C").Resize(1, LastCol - 2).FormulaR1C1 = "=sum(R2C:R[-1]C)"

         'format the last row to bold
        Cells(TotalRow, "C").Resize(1, LastCol - 2).Font.Bold = True
         'Cells(.Rows.Count, 1).End(xlUp).Resize(1, LastCol).Font.Bold = True

         'set target voucher cells
        Cells(InvVoucher, "D").Resize(1, LastCol - 3).Select
        With Selection.Borders
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Selection.Borders(xlInsideVertical)
            .LineStyle = xlNone
        End With
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlNone
        End With
         
         
        Cells(TotalRow, "C").Value = "TOTALS"
        Cells(InvVoucher, "C").Value = "Enter Invoice Target $"
        Cells(InvVoucher, "C").Select
        Selection.Font.Bold = True
        Selection.HorizontalAlignment = xlRight
        Cells(BalRange, "C").Value = "Balance"
        Cells(BalRange, "C").Select
        Selection.Font.Bold = True
        Selection.HorizontalAlignment = xlRight
         
         
         
' Need this section to format based on comparison that cells in same column above in TOTALS row and INVVOUCHER row are <>
        Cells(BalRange, "D").Resize(1, LastCol - 3).Select
        With Selection
            .FormatConditions.Delete
            .FormatConditions.Add Type:=xlExpression, Formula1:= _
              "=IF(" & Cells(TotalRow, "D").Address(True, True) & "<>" & _
                Cells(InvVoucher, "D").Address(True, True) & ",TRUE,)"
            .FormatConditions(1).Interior.ColorIndex = 3
        End With
    End With
    Application.ScreenUpdating = True
    Range("A2").Select
End Sub

Open in new window

0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 33

Expert Comment

by:Norie
ID: 36718047
I think the other guys have it covered but I'll post this anyway.
Dim wsRaw As Worksheet
Dim rng As Range
Dim rngTotals As Range
Dim LastCol As Long
Dim LastRow As Long

    Set wsRaw = Worksheets("raw data")

    LastCol = wsRaw.Cells(1, Columns.Count).End(xlToLeft).Column
    LastRow = wsRaw.Range("A" & Rows.Count).End(xlUp).Row

    Set rng = wsRaw.Cells(2, LastCol - 1).Resize(LastRow - 1, 2)

    With rng.FormatConditions

        .Delete
        .Add Type:=xlExpression, Formula1:="=RC" & (LastCol - 1) & "+" & "RC" & LastCol & "<=RC" & LastCol - 2

        .Item(1).Interior.ColorIndex = 35
        .Add Type:=xlExpression, Formula1:="=RC" & (LastCol - 1) & "+" & "RC" & LastCol & ">RC" & LastCol - 2

        .Item(2).Interior.ColorIndex = 3

    End With

    Set rngTotals = wsRaw.Cells(LastRow + 1, LastCol - 2)

    rngTotals.Value = "TOTALS"
    With rngTotals.Resize(, 3)

        With .Borders(xlEdgeTop)

            .LineStyle = xlDouble
            .Weight = xlThick
            .ColorIndex = xlAutomatic
        End With
        .Font.Bold = True
    End With

    rngTotals.Offset(, 1).Resize(, 2).FormulaR1C1 = "=SUM(R2C:R[-1]C)"

    With rngTotals.Offset(2)
        .HorizontalAlignment = xlRight
        .Value = "Enter Invoice Target $"
        .Resize(, 3).BorderAround xlContinuous, xlMedium, xlColorIndexAutomatic

    End With

    With rngTotals.Offset(3)

        .Value = "BALANCE"
        .HorizontalAlignment = xlRight
        With .Offset(, 1).Resize(, 2).FormatConditions
            .Delete
            .Add xlExpression, Formula1:="=R[-3]C" & LastCol - 1 & "<>R[-1]C" & LastCol
            .Item(1).Interior.ColorIndex = 3
        End With
    End With


    wsRaw.Range("A1").Resize(, LastCol).Interior.ColorIndex = 15

Open in new window

0
 

Author Closing Comment

by:matttclark
ID: 36718300
Thanks all, great quick responses.

Kannan(KK) Yeah you can do it manually, but that's just a portion of what goes on with this code and would defeat the purpose of automating all of it.  Thanks for taking a look though.

Stephen, thanks this did the trick!  I did have to add ".select" to the end of the "With Range" line and "selection." to the next three lines with the Format Conditons" statements to get it to put conditional formatting references to the correct range. On my PC without this, D10 was referring to colum E in conditional formatting and E10 was referring to column F. Not quite sure why??


Andrew, this worked partially but both D10 and E10 were pointing to Column D formulas on my PC when I tried this.  I could not figure why or come up with a quick mod like for Stephens, so I awarded him points. Thank you very much though, you guys are all awesome!
0
 

Author Comment

by:matttclark
ID: 36718334
imnorie,

was working on award notes, did not see yours unitl after awarded.

Thanks very much for posting, I will spend some time reviewing your code to learn from. It looks like it could teach me a thing or two! However, as you commented it was already covered..

regards,
matt
0
 

Author Comment

by:matttclark
ID: 36718346
sorry should have posted final code snippet, not just commented:

With Range("D" & r + 3).Resize(, 2).Select
    Selection.FormatConditions.Delete
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=D" & r & "<>D" & r + 2
    Selection.FormatConditions(1).Interior.ColorIndex = 3
End With

Open in new window

0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now