VBA to identify error in certain columns

Hello Experts,

I am looking for a VBA script to identify errors at following.

1.  COLUMN A: PLEASE HIGHLIGHT YELLOW ANY ROW NOT START WITH RMIRAAxxxxxxxx( X is for  8 digit numbers) OR
RCKIRUxxxxxxxx ( X is for 8 digit numbers)

2.  COLUMN C = COLUMN A, HIGHLIGHT YELLOW ANYROW THAT IS NOT EQUAL.

3.  COLUMN E TAG SHOULD START WITH Axxxxxx (x for 6 numbers ). HIGHLIGHT YELLOW ANY ROW THAT IS NOT  START WITH Axxxxxx.

4.  COLUMN H = COLUMN I + COLUMN J.  HIGHLIGHT YELLOW ANY ROW THAT IS NOT.

5.  COLUMN Q: HIGHLIGHT YELLOW ANY ROW NOT START WITH 0056-XXXX ( X STAND FOR 4 NUMBERS) OR BLANK ROW.

6.  COLUMN S: HIGHLIGHT ANY ROW WITH WORD " Unclassfied" or BLANK ROW

Attached is the sample file.

Please help.  Thank You in Advance !
Sample_December_07_2017.xlsx
Kathryn TranAsked:
Who is Participating?
 
Subodh Tiwari (Neeraj)Connect With a Mentor Excel & VBA ExpertCommented:
Please give this a try...
In the attached, click the button called "Highlight Errors" in A1.
Sub HighlightErrors()
Dim ws As Worksheet
Dim lr As Long

Application.ScreenUpdating = False

Set ws = ActiveSheet
lr = ws.Cells(Rows.Count, 1).End(xlUp).Row

ws.AutoFilterMode = False
ws.Range("AB2:AB" & lr).Formula = "=A2=C2"
ws.Range("AB2:AB" & lr).Value = ws.Range("AB2:AB" & lr).Value
ws.Range("AC2:AC" & lr).Formula = "=H2=I2&"" ""&J2"
ws.Range("AC2:AC" & lr).Value = ws.Range("AC2:AC" & lr).Value

With ws.Rows(1)
    .AutoFilter Field:=1, Criteria1:="<>*RMIRAA*", Operator:=xlAnd, Criteria2:="<>*RCKIRU*"
    If ws.Range("A1:A" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
        ws.Range("A2:AA" & lr).SpecialCells(xlCellTypeVisible).Interior.Color = vbYellow
    End If
    .AutoFilter Field:=1
    .AutoFilter Field:=28, Criteria1:="FALSE"
    If ws.Range("A1:A" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
        ws.Range("A2:AA" & lr).SpecialCells(xlCellTypeVisible).Interior.Color = vbYellow
    End If
    .AutoFilter Field:=28
    .AutoFilter Field:=5, Criteria1:="<>A*"
    If ws.Range("A1:A" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
        ws.Range("A2:AA" & lr).SpecialCells(xlCellTypeVisible).Interior.Color = vbYellow
    End If
    .AutoFilter Field:=5
    .AutoFilter Field:=29, Criteria1:="FALSE"
    If ws.Range("A1:A" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
        ws.Range("A2:AA" & lr).SpecialCells(xlCellTypeVisible).Interior.Color = vbYellow
    End If
    .AutoFilter Field:=29
    .AutoFilter Field:=17, Criteria1:="<>0056*"
    If ws.Range("A1:A" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
        ws.Range("A2:AA" & lr).SpecialCells(xlCellTypeVisible).Interior.Color = vbYellow
    End If
    .AutoFilter Field:=17
    .AutoFilter Field:=19, Criteria1:="=Unclassified", Operator:=xlOr, Criteria2:="="
    If ws.Range("A1:A" & lr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
        ws.Range("A2:AA" & lr).SpecialCells(xlCellTypeVisible).Interior.Color = vbYellow
    End If
    .AutoFilter
End With
ws.Columns("AB:AC").Delete
Application.ScreenUpdating = True
End Sub

Open in new window

Highlight-Errors.xlsm
1
 
ShumsConnect With a Mentor Distinguished Expert - 2017Commented:
Hi Kathryn,

I wouldn't advice to highlight the entire row, you wouldn't know for which above mentioned criteria rows are highlighted, I would highlight cells with above criteria, please try below:
Sub IdentifyErrors()
Dim Ws As Worksheet
Dim LRow As Long
Dim c As Range, Rng As Range

'Define Variables
Set Ws = Worksheets("Sheet1")
LRow = Ws.Range("A" & Rows.Count).End(xlUp).Row

'Disable Events
With Application
    .ScreenUpdating = False
    .DisplayStatusBar = True
    .StatusBar = "!!! Please Be Patient...Checking Errors !!!"
    .EnableEvents = False
    .Calculation = xlManual
End With

'Remove Previous Highlights
With Ws.Range("A2:AA" & LRow)
    .Interior.ColorIndex = xlColorIndexAutomatic
    .Font.ColorIndex = xlColorIndexAutomatic
End With

'Highlight Column A
Ws.Range("AB2:AB" & LRow).FormulaR1C1 = "=IF(LEFT(RC1,6)<>""RMIRAA"",""Error"","""")"
Ws.Range("AB2:AB" & LRow).Value = Ws.Range("AB2:AB" & LRow).Value
Set Rng = Ws.Range("AB2:AB" & LRow)
For Each c In Rng
    If c.Value = "Error" Then
        c.Offset(0, -27).Interior.Color = vbYellow
        c.Offset(0, -27).Font.Color = vbRed
    End If
Next c
Rng.ClearContents

'Highlight Column C
Ws.Range("AB2:AB" & LRow).FormulaR1C1 = "=IF(RC1<>RC3,""Error"","""")"
Ws.Range("AB2:AB" & LRow).Value = Ws.Range("AB2:AB" & LRow).Value
Set Rng = Ws.Range("AB2:AB" & LRow)
For Each c In Rng
    If c.Value = "Error" Then
        c.Offset(0, -25).Interior.Color = vbYellow
        c.Offset(0, -25).Font.Color = vbRed
    End If
Next c
Rng.ClearContents

'Highlight Column E
Ws.Range("AB2:AB" & LRow).FormulaR1C1 = "=IF(LEFT(RC5,1)<>""A"",""Error"","""")"
Ws.Range("AB2:AB" & LRow).Value = Ws.Range("AB2:AB" & LRow).Value
Set Rng = Ws.Range("AB2:AB" & LRow)
For Each c In Rng
    If c.Value = "Error" Then
        c.Offset(0, -23).Interior.Color = vbYellow
        c.Offset(0, -23).Font.Color = vbRed
    End If
Next c
Rng.ClearContents

'Highlight Column H
Ws.Range("AB2:AB" & LRow).FormulaR1C1 = "=IF(ISNUMBER(SEARCH(RC9,RC8))+ISNUMBER(SEARCH(RC10,RC8))>1,"""",""Error"")"
Ws.Range("AB2:AB" & LRow).Value = Ws.Range("AB2:AB" & LRow).Value
Set Rng = Ws.Range("AB2:AB" & LRow)
For Each c In Rng
    If c.Value = "Error" Then
        c.Offset(0, -20).Interior.Color = vbYellow
        c.Offset(0, -20).Font.Color = vbRed
    End If
Next c
Rng.ClearContents

'Highlight Column Q
Ws.Range("AB2:AB" & LRow).FormulaR1C1 = "=IF(LEFT(RC17,4)<>""0056"",""Error"","""")"
Ws.Range("AB2:AB" & LRow).Value = Ws.Range("AB2:AB" & LRow).Value
Set Rng = Ws.Range("AB2:AB" & LRow)
For Each c In Rng
    If c.Value = "Error" Then
        c.Offset(0, -11).Interior.Color = vbYellow
        c.Offset(0, -11).Font.Color = vbRed
    End If
Next c
Rng.ClearContents

'Highlight Column S
Ws.Range("AB2:AB" & LRow).FormulaR1C1 = "=IF(OR(RC19=""Unclassified"",RC19=""""),""Error"","""")"
Ws.Range("AB2:AB" & LRow).Value = Ws.Range("AB2:AB" & LRow).Value
Set Rng = Ws.Range("AB2:AB" & LRow)
For Each c In Rng
    If c.Value = "Error" Then
        c.Offset(0, -9).Interior.Color = vbYellow
        c.Offset(0, -9).Font.Color = vbRed
    End If
Next c
Rng.ClearContents

'Enable Events
With Application
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .StatusBar = False
    .EnableEvents = True
    .Calculation = xlAutomatic
End With
End Sub

Open in new window

Kathryn_Sample_December_07_2017_v1a.xlsm
1
 
Kathryn TranAuthor Commented:
Dear Subodh and Shums,

Thank You Both So Much for your quick and kindest help with my urgent project. I can't wait to test out the solutions from the best of the best experts.  I will keep you posted shortly.  Please stay tune...

Best Regards,
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.