VBA Code for Highlighting Cells based on If then Rules

[SKD7]

Hi, Attached is the excel data file Updated Data File.xlsx for which I need to create a visual basic code with the following rules.

1. If AssetCondition=Good and ReviseRul=0 and RULCalculated<=10, highlight all 3 cells.
2. If AssetCondition=Good and ReviseRul=1 and RULOverride<=10, highlight all 3 cells.
3. If Priority=Priority 1 and Level 5 does not include any of the following words=UPS, Emergency, Fire, Annunciation, Generator, Sprinkler, highlight both cells.
4. If RULCalculated!=YearinService+EUL-Current Year, highlight all 3 cells.
5. IfUnitCost field is blank, then highlight that cell.
6. If Manufacturer field is blank, then input "Not Visible" in cell
7. If CapacityUnitOfMeasure=numeric value, highlight cell.
8. Update all cells in PlanType column as capital letters.
9. If YearManufactured contains comma then highlight cell.

Can someone please help me write this rule. Thanks in advance

[June7]

Why do you need VBA instead of using Conditional Formatting? The VBA would be complicated and quite a bit of work. One way to develop VBA is to use macro recorder. It will produce some basic code that can be modified to better fit your requirement.

[SKD7]

2 reasons
1. The above rules posted are only a sample, the overall set of rules about 50 rules and not all include highlighting eg. please see item 6 and 8.
2. Conditional formatting with soo many rules and 8000 rows data would make the file slow.

But I could be wrong and more than happy for you to advise how this can be achieved using conditional formatting. Please let me know.

[DanWall]

Your question looks identical to one at Mr Excel.

[DanWall]

This one.

[June7]

Okay, here is a possible approach showing the first 2 rules.

Private Sub Worksheet_Change(ByVal Target As Range)
SetHighlight
End Sub


Sub SetHighlight()
Dim r As Integer, rCount As Integer
rCount = Range("A" & Rows.Count).End(xlUp).Row
For r = 2 To rCount
    Macro2 r, 16
    Macro2 r, 42
    Macro2 r, 43
    Macro2 r, 44
    If Cells(r, 16).Value = "Good" And Cells(r, 42).Value = 0 And Cells(r, 43).Value <= 10 Then
        Macro1 r, 16
        Macro1 r, 42
        Macro1 r, 43
    End If
    If Cells(r, 16).Value = "Good" And Cells(r, 42).Value = 1 And Cells(r, 44).Value <= 10 Then
        Macro1 r, 16
        Macro1 r, 42
        Macro1 r, 44
    End If
Next
End Sub


Sub Macro1(r As Integer, c As Integer)
    With Cells(r, c).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("P2").Select
End Sub


Sub Macro2(r As Integer, c As Integer)
    With Cells(r, c).Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub

[June7]

Rules 6 and 8 are not conditional formatting, they are editing data. Find/Replace could fix Manufacturer column for all rows but need a VBA procedure to fix PlanType to all upper case.
Then include code for row edit.

Revision to target only edited row.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Integer
r = Target(1).Row
SetHighlight r
If IsEmpty(Cells(r, 25)) Then Cells(r, 25).Value = "Not Visible" 'Rule 6
Cells(r, 17).Value = UCase(Cells(r, 17).Value) 'Rule 8
End Sub

Sub SetHighlight(r As Integer)
Macro2 r, 16
Macro2 r, 42
Macro2 r, 43
Macro2 r, 44
If Cells(r, 16).Value = "Good" And Cells(r, 42).Value = 0 And Cells(r, 43).Value <= 10 Then
    Macro1 r, 16
    Macro1 r, 42
    Macro1 r, 43
End If
If Cells(r, 16).Value = "Good" And Cells(r, 42).Value = 1 And Cells(r, 44).Value <= 10 Then
    Macro1 r, 16
    Macro1 r, 42
    Macro1 r, 44
End If
End Sub

Sub Macro1(r As Integer, c As Integer)
    With Cells(r, c).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub

Sub Macro2(r As Integer, c As Integer)
    With Cells(r, c).Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub