Conditional Format Cell Fill using VBA 1

[shelby55]

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:

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:

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.

 

[SkipVought]

How are the column B cells turning yellow, when that code has been removed?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[shelby55]

Hi

I don't know. Below is the 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 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

 

[SkipVought]

My column B changes NOT.

I cannot understand that if you BEGIN the process; copy the template; run AbstractData; make change to the new sheet in column J or even B for that matter.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[shelby55]

Hi Skip

I don't copy the template and run AbstractData, AbstractData runs copying the template to create a worksheet per entry in the worksheet of "raw data".

AbstractData() is at the top of the post...should this code be incorporated into that somehow?

 

[SkipVought]

THAT is the process that I am referring to: the process of INITIALIZING your sheet.

If the user happens to change the shading on the sheet, do you want some code to change that shading? There is no event that 'recognizes' such changes -- only changes in VALUES. Of course, you could write some fancy code to run on the Worksheet_SelectionChange event, but that might be a daunting task for you.

The posted code will change the shading in column J ONLY!!!

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[shelby55]

Hi Skip

So then how do I limit this to only be for Rows 5 to 38?

Thanks.

 

[SkipVought]

Change the Set rng statement...

    Set rng = Intersect(ActiveSheet.UsedRange, rows("5:38"))

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[shelby55]

Thanks Skip!!

 

[shelby55]

Hi

Sorry to be a pain but how do I limit to the columns of A to J?

I tried:

 Set rng = Intersect(ActiveSheet.UsedRange, Rows("5:38"), Columns("B:J"))

but it still changes to orange if entry in column R.

Thanks.

 

[SkipVought]

Well you removed rng from the intersect, thus causing the ENTIRE USED RANGE to be included!!!

So you want rows 5:38 and B:J to be the area within shading CAN take place and specifically when the column J value <> the column B value, then B:J for that row would be shaded?

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim t As Range, rng As Range
    
    Set rng = Intersect(Rows("5:38"), Range([b1], [j1]).EntireColumn)
   
    For Each t In Target
        With Intersect(t.EntireRow, rng)
        
        'is change in column J?
            If Not Intersect(t, 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,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[shelby55]

Hi Skip

Thanks but I don't want the entire row to be yellow, only the cell in J. Is that possible?

 

[SkipVought]

then explain "how do I limit to the columns of A to J?"

What does that mean, rather than limit ot column J"

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[shelby55]

Figured it out from your other comments: change to only be "with t" and not the range. Thanks Skip.

There are still issues if the user changes the selection and then changes it back to be the same as column B. I realize that is because of the code. You indicated in one of your posts

Of course, you could write some fancy code to run on the Worksheet_SelectionChange event, but that might be a daunting task for you.

Can you point me in the direction of the concepts behind the "fancy code"? Daunting or not I would like to see if I can make it happen. Thanks.

 

[SkipVought]

First write a detail specification discribing what should happen when changes are made in the various areas of the sheet. Include what adds the shading and what removes the shading.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[shelby55]

Hi Skip

The cells in J2 to J38 need to match the value of the corresponding cells in B2 to B38..so J2 needs to match B2, J3 needs to match B3 etc. and if not, then the cells in J needs to change colour.

As I mentioned, they will always match on initialization because the data was copied from the same source to both columns. So if the user changes the data in J to not match B then the cell in J needs to change to be yellow. If the user then changes the value in J back to match the value in B then it needs to be with white fill (not nothing, white).

Is that enough detail? Thanks.

 

[SkipVought]

Isn't that what the latest published code does, with the exception of White, which is .Interior.Color = vbWhite as originally posted.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[shelby55]

No, Skip, it doesn't. If I change J6 to not match B6 then it turns yellow but if I change back so it matches B6 then it doesn't turn back to white because the code is only on change not on matching.

 

[SkipVought]

because the code is only on change not on matching

NOT TRUE!!!

        'is change in column J?
            If Not Intersect(t, rng, Cells(1, "J").EntireColumn) Is Nothing Then
                If t.Value <> Cells(t.Row, "B").Value Then
                    .Interior.Color = 49407[b][highlight]
                Else
                    .Interior.ColorIndex = xlColorIndexNone[/highlight][/b]
                End If
            End If
        End With

If you want WHITE then, as advised previously...

[b][highlight]
                Else
                    .Interior.Color = vbwhite[/highlight][/b]
                End If

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}