Help simplifying a filtering/highlighting code

Hi, I need some help with simplifying a code so that it will run faster. Basically, I am validating data (dates). Here is the scenario.. columns 23, 21, 19, 18 and 12. What I am validating is that there are no missing dates that have not been completed when they should have been. The order of events should be:

Column 12's date is completed
Then 18's date is completed
Then 19
21
23..


So, if 23 is completed, then there should be dates in columns 21, 19, 18 and 12. -- I need to identify any missing dates and highlight that particular cell in Row A as well as the cell that is missing the date.

You can see below that I just went through each one by one but am pretty sure there is a better way to do it. I went:

To check 23, I went through each one individually. Then after that, I went through the same process with 21.... , 19 ,etc.

Appreciate any help!

Please Login or Register  to view this content.

On Error Resume Next
myRange.AutoFilter Field:=23, Criteria1:="="
myRange.AutoFilter Field:=21, Criteria1:="<>"
If myRange.SpecialCells(xlCellTypeVisible).Count > 0 Then
Range("$U1:$U" & lr).SpecialCells(xlCellTypeVisible).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
myRange.SpecialCells(xlCellTypeVisible).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else: ActiveSheet.ShowAllData
End If
'
ActiveSheet.ShowAllData
On Error Resume Next
myRange.AutoFilter Field:=23, Criteria1:="="
myRange.AutoFilter Field:=21, Criteria1:="<>"
myRange.AutoFilter Field:=19, Criteria1:="<>"
If myRange.SpecialCells(xlCellTypeVisible).Count > 0 Then
myRange("S1:S").SpecialCells(xlCellTypeVisible).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
myRange.SpecialCells(xlCellTypeVisible).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else: ActiveSheet.ShowAllData
End If
'
ActiveSheet.ShowAllData
On Error Resume Next
myRange.AutoFilter Field:=23, Criteria1:="="
myRange.AutoFilter Field:=21, Criteria1:="<>"
myRange.AutoFilter Field:=19, Criteria1:="<>"
myRange.AutoFilter Field:=18, Criteria1:="<>"
If myRange.SpecialCells(xlCellTypeVisible).Count > 0 Then
myRange("$R1:$R" & lr).SpecialCells(xlCellTypeVisible).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
myRange("$A1:$A" & lr).SpecialCells(xlCellTypeVisible).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else: ActiveSheet.ShowAllData
End If
'
ActiveSheet.ShowAllData
On Error Resume Next
myRange.AutoFilter Field:=23, Criteria1:="="
myRange.AutoFilter Field:=21, Criteria1:="<>"
myRange.AutoFilter Field:=19, Criteria1:="<>"
myRange.AutoFilter Field:=18, Criteria1:="<>"
myRange.AutoFilter Field:=12, Criteria1:="<>"
If myRange.SpecialCells(xlCellTypeVisible).Count > 0 Then
myRange("$L1:$L" & lr).SpecialCells(xlCellTypeVisible).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
myRange("$A1:$A" & lr).SpecialCells(xlCellTypeVisible).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else: ActiveSheet.ShowAllData
End If
'
ActiveSheet.ShowAllData
On Error Resume Next
myRange.AutoFilter Field:=21, Criteria1:="="
myRange.AutoFilter Field:=19, Criteria1:="<>"
If myRange.SpecialCells(xlCellTypeVisible).Count > 0 Then
myRange("$S1:$S" & lr).SpecialCells(xlCellTypeVisible).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
myRange("$A1:$A" & lr).SpecialCells(xlCellTypeVisible).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else: ActiveSheet.ShowAllData
End If
'
ActiveSheet.ShowAllData
On Error Resume Next
myRange.AutoFilter Field:=21, Criteria1:="="
myRange.AutoFilter Field:=19, Criteria1:="<>"
myRange.AutoFilter Field:=18, Criteria1:="<>"
If myRange.SpecialCells(xlCellTypeVisible).Count > 0 Then
myRange("$R1:$R" & lr).SpecialCells(xlCellTypeVisible).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("$A1:$A" & lr).SpecialCells(xlCellTypeVisible).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else: ActiveSheet.ShowAllData
End If
'
ActiveSheet.ShowAllData
On Error Resume Next
myRange.AutoFilter Field:=21, Criteria1:="="
myRange.AutoFilter Field:=19, Criteria1:="<>"
myRange.AutoFilter Field:=18, Criteria1:="<>"
myRange.AutoFilter Field:=12, Criteria1:="<>"
If myRange.SpecialCells(xlCellTypeVisible).Count > 0 Then
myRange("$L1:$L" & lr).SpecialCells(xlCellTypeVisible).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
myRange("$A1:$A" & lr).SpecialCells(xlCellTypeVisible).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else: ActiveSheet.ShowAllData
End If
'
ActiveSheet.ShowAllData
On Error Resume Next
myRange.AutoFilter Field:=19, Criteria1:="="
myRange.AutoFilter Field:=18, Criteria1:="<>"
If myRange.SpecialCells(xlCellTypeVisible).Count > 0 Then
myRange("$R1:$R" & lr).SpecialCells(xlCellTypeVisible).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("$A1:$A" & lr).SpecialCells(xlCellTypeVisible).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else: ActiveSheet.ShowAllData
End If
'
ActiveSheet.ShowAllData
On Error Resume Next
myRange.AutoFilter Field:=19, Criteria1:="="
myRange.AutoFilter Field:=18, Criteria1:="<>"
myRange.AutoFilter Field:=12, Criteria1:="<>"
If myRange.SpecialCells(xlCellTypeVisible).Count > 0 Then
myRange("$L1:$L" & lr).SpecialCells(xlCellTypeVisible).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
myRange("$A1:$A" & lr).SpecialCells(xlCellTypeVisible).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else: ActiveSheet.ShowAllData
End If
'
ActiveSheet.ShowAllData
On Error Resume Next
myRange.AutoFilter Field:=18, Criteria1:="="
myRange.AutoFilter Field:=12, Criteria1:="<>"
If myRange.SpecialCells(xlCellTypeVisible).Count > 0 Then
myRange("$L1:$L" & lr).SpecialCells(xlCellTypeVisible).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
myRange.SpecialCells(xlCellTypeVisible).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Else: ActiveSheet.ShowAllData
End If
'
ActiveSheet.ShowAllData
myRange("$A1:$A" & lr).AutoFilter Field:=1, Criteria1:=RGB(255 _
, 0, 0), Operator:=xlFilterCellColor
Sheets("Sheet2").Select
Sheets("Sheet2").Copy After:=Sheets(2)
Sheets("Sheet2 (2)").Select
Range("$A1:$A").AutoFilter Field:=1, Operator:= _
xlFilterNoFill
Rows("1:1").Select
Selection.EntireRow.Hidden = True
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
ActiveWorkbook.Worksheets("Sheet2 (2)").AutoFilter.Sort.SortFields.Clear
ActiveSheet.ShowAllData
Rows("1:1").Select
Selection.EntireRow.Hidden = False
Sheets("Sheet2 (2)").Name = "Missing Dates"
Cells.Select

Please Login or Register  to view this content.

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE]Please [url=https://www.excelforum.com/login.php]Login or Register [/url] to view this content.[/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here



(This thread should receive no further responses until this moderation request is fulfilled, as per Forum Rule 7)

I put the code/code thing on there. I will try again.

Please Login or Register  to view this content.