Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Conditional Format Cell Fill using VBA 1

Status
Not open for further replies.
shelby55

shelby55

Technical User
Jun 27, 2003
1,229
CA
Hi

I wish to use VBA to conditionally format a cell in Excel 2010.
I know this should be easy but I can't seem to get it to work.

I have to columns (B5:B31) and (J5:J31). If J column doesn't correspond to B column then I wish the J cell be filled with a certain colour. Comparison is only for the adjacent cell i.e. J5 comparing to B5, J6 comparing to B6 etc.

Potentially complicating the matter is that I have a worksheet that I call "template" which, when a macro is run, populates singluar worksheets per abstract. The code for that (thanks to Skip) is:

Code: 
Sub AbstractData()
Dim r As Range, wsAdd As Worksheet, t As Range, rSEQ_NO As Range, mypassword As String, ws As Worksheet

With Sheets("RawData_A")
Set rSEQ_NO = .Rows(1).Find("SEQ_NO")

If Not rSEQ_NO Is Nothing Then
For Each r In .Range(.[A2], .[A2].End(xlDown))


Sheets("Template").Copy After:=Sheets(Sheets.Count)
Set wsAdd = ActiveSheet
wsAdd.Name = .Cells(r.Row, rSEQ_NO.Column).Value
wsAdd.Tab _
.Color = 49407


For Each t In [From]
.Range(.Cells(r.Row, t.Value), .Cells(r.Row, t.Offset(0, 1).Value)).Copy
wsAdd.Range(t.Offset(0, 2).Value).PasteSpecial _
Paste:=xlPasteAll, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

wsAdd.Range("A5.J87").HorizontalAlignment = xlLeft

Next
Next
End If
End With

End Sub

When I record a macro to show the comparison and changing of cell colour it is:

Code: 
Sub format_test()
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=$J$14<>$B$14"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
End Sub

I'm assuming the function will have to be built into the template so it copies to all the worksheets but not sure. Any assistance greatly appreciated.
 
Sort by date Sort by votes
Shelby,

Why would you use VBA? Why not use the native Conditional Formatting feature?

With Excel 2007+, if your Table is defined as a Structured Table (Data > Tables > Table), the CF range can be related to the table column ranges as they change.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Hi Skip

I don't want to use conditional formatting because the workbook may be required in different versions of Excel and I know there could be problems because conditional formatting is different between them. I believe 2007 and 2010 are similar but 2003 isn't.

Thanks.
 
Upvote 0 Downvote


What is the Selection? You need to EXPLICITLY define the range to be selected, within the procedure.

The cell references should NOT be absolute, rather relative...
Code: 
Sub format_test()
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=[highlight]J14<>B14[/highlight]"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
End Sub

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
BTW, you ARE using Excel 2007+ code!!!

I doubt that this code will run in 97-2003.

THIS is a strictly VBA solution for rows 14:16...
Code: 
Sub CF_Text()
    Dim r As Range
    
    For Each r In Range("B14:B16")
        If r.Value <> Cells(r.Row, "J").Value Then
            Intersect(r.EntireRow, r.Parent.UsedRange).Interior.Color = 49407
        Else
            Intersect(r.EntireRow, r.Parent.UsedRange).Interior.Color = vbWhite
        End If
    Next
End Sub


Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote

This is a bit more efficient...
Code: 
Sub CF_Text()
    Dim r As Range, rng As Range
    
    Set rng = ActiveSheet.UsedRange
    
    For Each r In Range("B14:B16")
        With Intersect(r.EntireRow, rng)
            If r.Value <> Cells(r.Row, "J").Value Then
                .Interior.Color = 49407
            Else
                .Interior.Color = vbWhite
            End If
        End With
    Next

    Set rng = nothing
    
End Sub

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
I wish to use VBA to conditionally format a cell in Excel 2010.
Click to expand...
I don't want to use conditional formatting because the workbook may be required in different versions of Excel and I know there could be problems because conditional formatting is different between them. I believe 2007 and 2010 are similar but 2003 isn't.
Click to expand...
Then WHY are you designing & coding in 2010? Your application is likely to fail in earlier versions.

You could design in Excel 2003 and run other version in Compatabliity mode.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Hi Skip

Thanks very much...but it doesn't work.

I assumed I was to insert the code in the worksheet of Template so it would be copied to all abstracts when AbstractData() was run.

So I went to one of the abstracts, changed the values in J14 to not match B14 and nothing happened to J14.

What am I doing wrong?
 
Upvote 0 Downvote

It appears that you...

1. COPY the Template SHEET within the workbook

2. COPY some CELLS and PASTE them into the new template copy.

IF the range that you paste into, is the same range that contains the Conditional FORMAT, (do you see what's coming?) the Conditional FORMAT is CHANGED, just as any other cell would CHANGE FORMAT is you pasted something into it.

You could PASTE SPECIAL and only past the VALUES, if that is indeed the case.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Hi Skip

I guess I didn't explain the process well.

With AbstractData() it is copying the same data into cells B5 to B38 as it is in J5 to J38. This is being used to review medical records so if the reviewer sees an error in the original data then they will change it in the J columns. So if they change it to not equal B anymore then I want it to be highlighted.

I was looking into the change by val but I want the highlight to occur if it doesn't match and not that it was changed (because if they change it back to match, it would still be highlighted if using the change function which I don't want).

Thanks.
 
Upvote 0 Downvote

Is your program or is the user, EITHER ONE, pasting ANYTHING into column B or column J?

If so, that paste process DESTROYS the CF!!!

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote

because if they change it back to match, it would still be highlighted if using the change function which I don't want
Click to expand...
NOT TRUE!!!

Here's how I would opt to do to using the Worksheet_Change event...
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim t As Range, rng As Range
    
    Set rng = ActiveSheet.UsedRange
    
    For Each t In Target
        With Intersect(t.EntireRow, rng)
    
        'is change in column B?
            If Not Intersect(t.EntireRow, rng, Cells(1, "B").EntireColumn) Is Nothing Then
                If t.Value <> Cells(t.Row, "J").Value Then
                    'shade this row
                    .Interior.Color = 49407
                Else
                    .Interior.Color = vbWhite
                End If
            End If
        'is change in column J?
            If Not Intersect(t.EntireRow, rng, Cells(1, "J").EntireColumn) Is Nothing Then
                If t.Value <> Cells(t.Row, "B").Value Then
                    .Interior.Color = 49407
                Else
                    .Interior.Color = vbWhite
                End If
            End If
        End With
    Next
    
    Set rng = Nothing
End Sub


Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Hi Skip

Thanks.

Cells B5 to B38 are the exact same as J5 to J38 to start. Cells B41 to B80 have data in them but not in column J because the reviewer is going to code the chart themselves and enter data in that column as they go.

The template is formatted with dividing lines which are wiped out by the current code making it white if matching. Taking the else code out to leave alone if they match works for the cells B5 to B38 but when data is entered in column J, it doesn't then change to be white due to the change in code.

Also, I would just like cell to have the colour and not the entire row. I see this has "entire row" and "entire column" but how can I limit only to certain rows/cells/columns?

Thanks.


 
Upvote 0 Downvote


If it is ONLY the cell that changed that you want shaded...
Code: 
    For Each t In Target[b]
        [s]With Intersect(t.EntireRow, rng)[/s]
        With t[/b]

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote

Sorry, I failed to address the WHITE cell issue...
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim t As Range, rng As Range
    
    Set rng = ActiveSheet.UsedRange
    
    For Each t In Target
        With t
    
        'is change in column B?
            If Not Intersect(t.EntireRow, rng, Cells(1, "B").EntireColumn) Is Nothing Then
                If t.Value <> Cells(t.Row, "J").Value Then
                    'shade this row
                    .Interior.Color = 49407
                Else
                    .Interior.ColorIndex = xlColorIndexNone
                End If
            End If
        'is change in column J?
            If Not Intersect(t.EntireRow, rng, Cells(1, "J").EntireColumn) Is Nothing Then
                If t.Value <> Cells(t.Row, "B").Value Then
                    .Interior.Color = 49407
                Else
                    .Interior.ColorIndex = xlColorIndexNone
                End If
            End If
        End With
    Next
    
    Set rng = Nothing
End Sub

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Hi Skip

Thanks very much, that fixes the B5 to B38.

However, as described, B41 to B80 have data in them from the onset because of the AbstractData() macro. They show as yellow (49407) at the start which is fine because J column is blank and therefore doesn't match. But if I enter in the exact codes as in column B41 to J41, then J41 also turns yellow.

I actually took out the part of the code for "is change in column B" because column B will always be right (or at least be the original data) and J is to compare to B.

So how to get it so that either B changes back to white if J is the same OR have B starting off as white and then only if J is different should J be highlighted?

Thanks.
 
Upvote 0 Downvote
P.S.
If this can't be done then if we can just control the range so that instead of all rows it's only rows 5 to 38 then that would be great. Thanks.
 
Upvote 0 Downvote

If the code for column B changing is commented out to begin with, before AbstractData() runs, would that not solve that issue?

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Hi

Nope...once copied the cells from B41 to B80 are yellow and don't change to white even if entries in J match them.

 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

thanhthanh12
  • Locked
  • Question
Help vba
Replies
3
Views
478
combo
combo
Andrzejek
  • Locked
  • Question
Outlook VBA - Trust access
Replies
3
Views
763
hermanlaksko
hermanlaksko
SLW89
  • Locked
  • Question
VBA newbie needs help
Replies
4
Views
423
Andrzejek
Andrzejek
xwb
  • Locked
  • Helpful tip
Performing VBA operations in other languages
Replies
1
Views
380
strongm
strongm
aldi07
  • Locked
  • Question
update a front-end databases with a new release using vba
Replies
2
Views
253
aldi07
aldi07

Part and Inventory Search

Sponsor

Back
Top