Macro / VBA to validate cells and write errors to a seperate errors sheet

R

RTorres82

New Member
Joined
May 20, 2016
Messages
2
Hi,

I'm trying to create a macro that runs loads of validations on a data sheet/template we receive. (there are a lot more than is currently in my code below)

When it finds an issue the macro formats the fill of the cell to red and then it needs to write the issue to an error report in a new sheet. The error report needs to write the row of the error in Col A and a brief description of the error in Col B.

I have got the below macro to half work in that it fills all the relevant cells in red, but I'm having a few issues with the error report:

1) There can be multiple validation errors in a row, but it seems to only be writing the last one to the error report. I need it to write all the validations per row beneath each other (I tried changing the IF statements to Elseif, this didn't work. I tried putting my loop within another loop 'For each cell in range', this didn't work). I'm not sure what to try next

2) The lastARow isn't working properly, it jumps and leaves blank rows inbetween the errors on the error sheet instead of the very next blank row. It is the same amount of rows inbetween as the next error in the data sheet.

3) Not a must, but a nice to have. Some of my validations are looking at if the cell <> "text", this text exists lists in another sheet ListData, but when I tried to use a named range to look in it throws a type mismatch error. It would be much easier to reference a list (named range) and maintain this then typing out them all in the IF statement.

Any advice would be greatly appreciated.

Code: 
Sub CheckValidations2()

Dim iRow As Long, lastRow As Long, firstRow As Long, ARow As Long, firstARow As Long, lastARow As Long



Application.Calculation = xlManual
Application.DisplayStatusBar = False
Application.ScreenUpdating = False


'Clear errors sheet (so that it can be rerun after errors corrected)

Sheets("Errors").Rows("2:" & Rows.Count).EntireRow.Delete



'Define first/last rows
With Sheets("Data").Select

    lastRow = Sheets("Data").Range("B" & Sheets("Data").Rows.Count).End(xlUp).Row
    firstRow = Sheets("Data").Range("14:14").Row
    
    lastARow = Sheets("Errors").Range("A" & Sheets("Errors").Rows.Count).End(xlUp).Row


'For each row run validations in columns, if there is an issue fill cell red and write error to errors sheet
    For iRow = firstRow To lastRow
                
                lastARow = lastARow + 1

    
    'See Description in last row of each If statement to see what the validation is doing
            
            If Sheets("Data").Cells(iRow, 6) < DateSerial(2015, 7, 1) And Sheets("Data").Cells(iRow, 2) <> "Indirects" Then
               Sheets("Data").Cells(iRow, 6).Interior.Color = RGB(255, 0, 0)
               Sheets("Errors").Cells(lastARow, 1).Value = Sheets("Data").Cells(iRow, 2).Row
               Sheets("Errors").Cells(lastARow, 2).Value = "Project Start date cannot be before 01/07/2015"
           End If
                        
           If Sheets("Data").Cells(iRow, 7) > DateSerial(2017, 12, 31) Then
               Sheets("Data").Cells(iRow, 7).Interior.Color = RGB(255, 0, 0)
               Sheets("Errors").Cells(lastARow, 1).Value = Sheets("Data").Cells(iRow, 2).Row
               Sheets("Errors").Cells(lastARow, 2).Value = "Project End date cannot be after 31/12/2017"
           End If
            
           If Sheets("Data").Cells(iRow, 7) < Sheets("Data").Cells(iRow, 6) Then
               Sheets("Data").Cells(iRow, 7).Interior.Color = RGB(255, 0, 0)
               Sheets("Errors").Cells(lastARow, 1).Value = Sheets("Data").Cells(iRow, 2).Row
               Sheets("Errors").Cells(lastARow, 2).Value = "Project End Date cannot be before Project Start Date"
           End If
            
           If Sheets("Data").Cells(iRow, 22) = "Yes" And Sheets("Data").Cells(iRow, 16) <> "Run Risk Like a Business" Then
               Sheets("Data").Cells(iRow, 16).Interior.Color = RGB(255, 0, 0)
               Sheets("Errors").Cells(lastARow, 1).Value = Sheets("Data").Cells(iRow, 2).Row
               Sheets("Errors").Cells(lastARow, 2).Value = "For Migrations the Workstream should be Run Risk Like a Business"
           End If
            
           If Sheets("Data").Cells(iRow, 8) <> "Activity" And Sheets("Data").Cells(iRow, 8) <> "Milestone" And _        
               Sheets("Data").Cells(iRow, 8) <> "Project CtA Cost & FTE" Then
               Sheets("Data").Cells(iRow, 8).Interior.Color = RGB(255, 0, 0)
               Sheets("Errors").Cells(lastARow, 1).Value = Sheets("Data").Cells(iRow, 2).Row
               Sheets("Errors").Cells(lastARow, 2).Value = "Record Type value not allowed/does not exist in dropdown list/cannot be blank"
            End If
            
            If Sheets("Data").Cells(iRow, 16) <> "Run Risk Like a Business" And Sheets("Data").Cells(iRow, 16) <> "Re-Engineering" And _
               Sheets("Data").Cells(iRow, 16) <> "Indirects" And Sheets("Data").Cells(iRow, 16)<> "Location Optimisation" Then
               Sheets("Data").Cells(iRow, 16).Interior.Color = RGB(255, 0, 0)
               Sheets("Errors").Cells(lastARow, 1).Value = Sheets("Data").Cells(iRow, 2).Row
               Sheets("Errors").Cells(lastARow, 2).Value = "Workstream value not allowed/does not exist in dropdown list/cannot be blank"
            End If
            
            If Sheets("Data").Cells(iRow, 17) = "Asia Pacific" And Sheets("Data").Cells(iRow, 18) <> "ASP Regional" And _
               Sheets("Data").Cells(iRow, 18) <> "Australia" And Sheets("Data").Cells(iRow, 18) <> "Bangladesh" And _
               Sheets("Data").Cells(iRow, 18) <> "Brunei" And Sheets("Data").Cells(iRow, 18) <> "HASE" And _
               Sheets("Data").Cells(iRow, 18) <> "Hong Kong" And Sheets("Data").Cells(iRow, 18) <> "India" And _
               Sheets("Data").Cells(iRow, 18) <> "Indonesia" And Sheets("Data").Cells(iRow, 18) <> "Japan" And _
               Sheets("Data").Cells(iRow, 18) <> "Korea" And Sheets("Data").Cells(iRow, 18) <> "Macua" And _
               Sheets("Data").Cells(iRow, 18) <> "China" And Sheets("Data").Cells(iRow, 18) <> "Malaysia" And _
               Sheets("Data").Cells(iRow, 18) <> "Maldives" And Sheets("Data").Cells(iRow, 18) <> "Mauritius" And _
               Sheets("Data").Cells(iRow, 18) <> "New Zealand" And Sheets("Data").Cells(iRow, 18) <> "Philippines" And _
               Sheets("Data").Cells(iRow, 18) <> "Singapore" And Sheets("Data").Cells(iRow, 18) <> "Sri Lanka" And _
               Sheets("Data").Cells(iRow, 18) <> "Taiwan" And Sheets("Data").Cells(iRow, 18) <> "Thailand" And _
               Sheets("Data").Cells(iRow, 18) <> "Vietnam" Then
               Sheets("Data").Cells(iRow, 18).Interior.Color = RGB(255, 0, 0)
               Sheets("Errors").Cells(lastARow, 1).Value = Sheets("Data").Cells(iRow, 2).Row
               Sheets("Errors").Cells(lastARow, 2).Value = "Country value not allowed/does not exist in dropdown list for Asia Pacific"
            End If
             
            If Sheets("Data").Cells(iRow, 17) = "GSC" And Sheets("Data").Cells(iRow, 18) <> "Polan - Krakow" And _
               And Sheets("Data").Cells(iRow, 18) <> "Philippines - Manila" And Sheets("Data").Cells(iRow, 18) <> "Malaysia - Kuala Lumpur" And _
               Sheets("Data").Cells(iRow, 18) <> "India - Bangalore" And Sheets("Data").Cells(iRow, 18) <> "India - Hyderabad" And _
               Sheets("Data").Cells(iRow, 18) <> "China - Taikoo Hui" Then
               Sheets("Data").Cells(iRow, 18).Interior.Color = RGB(255, 0, 0)
               Sheets("Errors").Cells(lastARow, 1).Value = Sheets("Data").Cells(iRow, 2).Row
               Sheets("Errors").Cells(lastARow, 2).Value = "Country value not allowed/does not exist in dropdown list for GSC"
           End If
             
           If Sheets("Data").Cells(iRow, 17) = "Holdings" And Sheets("Data").Cells(iRow, 18) <> "Holdings" Then
               Sheets("Data").Cells(iRow, 18).Interior.Color = RGB(255, 0, 0)
               Sheets("Errors").Cells(lastARow, 1).Value = Sheets("Data").Cells(iRow, 2).Row
               Sheets("Errors").Cells(lastARow, 2).Value = "Country value not allowed/does not exist in dropdown list for Holdings"
           End If
             
           If Sheets("Data").Cells(iRow, 17) = "LATAM" And Sheets("Data").Cells(iRow, 18) <> "Argentina" And _
               Sheets("Data").Cells(iRow, 18) <> "Brazil" And Sheets("Data").Cells(iRow, 18) <> "LAM Regional" And _
               Sheets("Data").Cells(iRow, 18) <> "Mexico" And Sheets("Data").Cells(iRow, 18) <> "Panama" Then
               Sheets("Data").Cells(iRow, 18).Interior.Color = RGB(255, 0, 0)
               Sheets("Errors").Cells(lastARow, 1).Value = Sheets("Data").Cells(iRow, 2).Row
               Sheets("Errors").Cells(lastARow, 2).Value = "Country value not allowed/does not exist in dropdown list for LATAM"
          End If
            
    Next iRow

End With

    
    
Application.Calculation = xlAutomatic
Application.DisplayStatusBar = True
Application.ScreenUpdating = True

End Sub
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
Sort by date Sort by votes
For 1) and 2) you should put this line:

Code: 
lastARow = lastARow + 1

Inside each of the block If statements like this:

Code: 
If Sheets("Data").Cells(iRow, 6) < DateSerial(2015, 7, 1) And Sheets("Data").Cells(iRow, 2) <> "Indirects" Then
    lastARow = lastARow + 1
    Sheets("Data").Cells(iRow, 6).Interior.Color = RGB(255, 0, 0)
    Sheets("Errors").Cells(lastARow, 1).Value = Sheets("Data").Cells(iRow, 2).Row
    Sheets("Errors").Cells(lastARow, 2).Value = "Project Start date cannot be before 01/07/2015"
End If

WBD
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Solved
Delete Rows using input box to multiple sheets
Replies
4
Views
240
Elle_mostlysunny
E
A
  • Question
Cannot enter text in textbox on form
Replies
3
Views
124
Anthony47
A
A
  • Solved
Application-defined or object defined Error when Filtering Listbox
Replies
4
Views
133
Peter_SSs
Peter_SSs
M
  • Question
Add in VBA Code to check zip code against pre-determined list
Replies
0
Views
145
mikefisher
M
A
  • Question
Run-time error '380' Could not set the Value property. Invalid property value
Replies
7
Views
220
aabrazil1
A

Forum statistics

Threads
1,214,605
Messages
6,120,473
Members
448,967
Latest member
visheshkotha

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top