VBA Code if this and that, then highlight both cells.

[ShwetaD]

Hi, Here's my dataset and I want to write a vba code such that

if AssetCondition="Fair" or "Fair-Good" And PlanType="Plan Type 3 - Capital Renewal" then highlight both AssetCondition and PlanType cells. I need to apply this rule to the whole sheet.

 

[Micron]

It would help to know what the column id's are, otherwise someone codes this as AssetCondition being B, and you say it doesn't work (because it's something else). Also would be better if you copied/pasted sheet cells rather than pic so that no one has to create that from scratch.
Might seem like an odd question, but are there any other Fair possibilities - such as Poor - Fair? If so, then one cannot use Instr function using "Fair" as the string to find.

 

[Trebor76]

Hi ShwetaD,

Welcome to MrExcel!!

Assuming AssetCondition is in Col. B and PlanType in Col. C (change the following if not) try this:

Option Explicit
Sub Macro1()

    Dim wsSrc As Worksheet
    Dim lngRow As Long, lngRowFrom As Long, lngRowTo As Long
    Dim strKey As String
    
    Set wsSrc = ThisWorkbook.Sheets("Sheet1") 'Sheet name containing the data. Change to suit if necessary.
    
    Application.ScreenUpdating = False
    
    With wsSrc
        lngRowFrom = 2
        lngRowTo = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        For lngRow = lngRowFrom To lngRowTo
            strKey = StrConv(.Range("B" & lngRow) & .Range("C" & lngRow), vbUpperCase)
            If strKey = "FAIRPLAN TYPE 3 - CAPITAL RENEWAL" Or strKey = "FAIR-GOODPLAN TYPE 3 - CAPITAL RENEWAL" Then
                .Range("B" & lngRow & ":C" & lngRow).Interior.Color = RGB(0, 255, 0) 'matching cells are coloured green. Change to suit.
            Else
                .Range("B" & lngRow & ":C" & lngRow).Interior.Color = xlNone 'Clear previous shading if the cells no longer meet the criteria.
            End If
        Next lngRow
    End With
    
    Application.ScreenUpdating = True

End Sub

Note while you've asked for a VBA solution you probably could achieve the same via Conditional Formatting.

Thanks,

Robert

 

[ShwetaD]

Hi Robert, thanks for sharing I have 35 such rules. Example 11 rules below. The idea is that everytime we receive data file, we run this macro to highlight anomalies. What in your opinion is easier to achieve, through condition formatting or through the script above. If condition formatting is the option, then could you provide 1 sample on how this can be implemented. Thanks in advance

1. If AssetCondition=Good/Fair-Food and ReviseRul=0 and RULCalculated<=10, highlight all 3 cells.
2. If AssetCondition=Good/Fair-Good and ReviseRul=1 and RULOverride<=10, highlight all 3 cells.
3. If AssetCondition=Fair/Poor-Fair/Poor and ReviseRul=0 and RULCalculated>10, highlight all 3 cells.
4. If AssetCondition=Fair/Poor-Fair/Poor and ReviseRul=1 and RULOverride>10, highlight all 3 cells.
5. If AssetCondition=Fair/Poor-Fair/Poor and PlanType!=Deferred Maintenance, highlight both cells.
6. If AssetCondition=Good/Fair-Food and PlanType=Deferred Maintenance, highlight both cells.
7. If AssetCondition=Good and ConditionRating!=0, highlight both cells.
8. If AssetCondition=Fair-Good and ConditionRating!=1, highlight both cells.
9. If AssetCondition=Fair and ConditionRating!=2, highlight both cells.
10. If AssetCondition=Poor-Fair and ConditionRating!=3, highlight both cells.
11. If AssetCondition=Poor and ConditionRating!=4, highlight both cells.

 

[Micron]

Which would be better, a Select Case block with 35 Cases or building a collection of 35 cf rules? Asking because I thought the vba rule limit was 4, but that might have been for Access, or regardless, it may no longer apply to Excel or Access.

 

[Trebor76]

condition formatting or through the script above

In my humble opinion I have found that many Conditional Formatting rules can start to slow Excel down so I'd probably lean towards VBA in this instance. Also while Select Case is easier to read than multiple IF statements I don't think it's possible to use it in this scenario.

It's going to take you some in setting up but here's how you could do the first two rules:

Option Explicit
Option Compare Text 'Makes all text comparisons case insensitive
Sub Macro2()

    Dim wsSrc As Worksheet
    Dim lngRow As Long, lngRowFrom As Long, lngRowTo As Long
    Dim strKey As String
  
    Set wsSrc = ThisWorkbook.Sheets("Sheet1") 'Sheet name containing the data. Change to suit if necessary.
  
    Application.ScreenUpdating = False
  
    With wsSrc
        lngRowFrom = 2
        lngRowTo = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        .Range("A" & lngRowFrom & ":H" & lngRowTo).Interior.Color = xlNone 'Clear all previous shading. Assumes date is in columns A to H. Change to suit.
        For lngRow = lngRowFrom To lngRowTo
            'Rules 1 and 2
            If .Range("B" & lngRow) = "Good/Fair-Food" Then
                If .Range("G" & lngRow) = 0 Or .Range("G" & lngRow) = 1 And .Range("H" & lngRow) <= 10 Then 'Assumes ReviseRul and RULCalculated are columns G and H respectively. Change to suit.
                    .Range("B" & lngRow & ",G" & lngRow & ":H" & lngRow).Interior.Color = RGB(0, 255, 0) 'Matching cells are coloured green. Change to suit.
                End If
            End If
        Next lngRow
    End With
  
    Application.ScreenUpdating = True

End Sub

Good luck with it.

Robert

 

[Micron]

I don't think it's possible to use it in this scenario.

Why is that?

 

[Trebor76]

I could be wrong. How would construct the first Case?

 

[Micron]

When it's generic like this, I use
Select Case = True

then pretty much anything can be evaluated as long as the result is T or F. That includes <>, =, <, >, Not, This And That, etc. So first Case:

Select Case True
   Case AssetCondition="Good/Fair-Food" And ReviseRul=0 And RULCalculated<=10

and that assumes ReviseRul and RULCalculated is an integer/long (number of some type)

 

[Trebor76]

Yes good call. So for rules 1 and 2 (I think splitting each rule makes things easier):

Option Explicit
Option Compare Text 'Makes all text comparisons case insensitive
Sub Macro2()

    Dim wsSrc As Worksheet
    Dim lngRow As Long, lngRowFrom As Long, lngRowTo As Long
    Dim strKey As String
   
    Set wsSrc = ThisWorkbook.Sheets("Sheet1") 'Sheet name containing the data. Change to suit if necessary.
   
    Application.ScreenUpdating = False
   
    With wsSrc
        lngRowFrom = 2
        lngRowTo = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        .Range("A" & lngRowFrom & ":H" & lngRowTo).Interior.Color = xlNone 'Clear all previous shading. Assumes date is in columns A to H. Change to suit.
        For lngRow = lngRowFrom To lngRowTo
            Select Case True
                Case .Range("B" & lngRow) = "Good/Fair-Good" And .Range("G" & lngRow) = 0 And .Range("H" & lngRow) <= 10 'Rule 1
                    .Range("B" & lngRow & ",G" & lngRow & ":H" & lngRow).Interior.Color = RGB(0, 255, 0) 'Matching cells are coloured green. Change to suit.
                Case .Range("B" & lngRow) = "Good/Fair-Good" And .Range("G" & lngRow) = 1 And .Range("H" & lngRow) <= 10 'Rule 2
                    .Range("B" & lngRow & ",G" & lngRow & ":H" & lngRow).Interior.Color = RGB(0, 255, 0) 'Matching cells are coloured green. Change to suit.
            End Select
        Next lngRow
    End With
   
    Application.ScreenUpdating = True

End Sub