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.
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
