+ Reply to Thread
Results 1 to 4 of 4

Help simplifying a filtering/highlighting code

Hybrid View

  1. 03-17-2016, 02:41 AM #1
    BG1983
    BG1983 is offline
    Forum Contributor
    Join Date
    08-08-2015
    Location
    North Carolina USA
    MS-Off Ver
    MS Office 2016
    Posts
    368

    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!

    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
    Reply With QuoteRegister To Reply
  2. 03-17-2016, 03:32 AM #2
    BadlySpelledBuoy
    BadlySpelledBuoy is offline
    Forum Expert BadlySpelledBuoy's Avatar
    Join Date
    06-14-2013
    Location
    East Sussex, UK
    MS-Off Ver
    365
    Posts
    7,951

    Re: Help simplifying a filtering/highlighting code

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

    Posting code between [CODE] [/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)
    Reply With QuoteRegister To Reply
  3. 03-17-2016, 08:47 AM #3
    BG1983
    BG1983 is offline
    Forum Contributor
    Join Date
    08-08-2015
    Location
    North Carolina USA
    MS-Off Ver
    MS Office 2016
    Posts
    368

    Re: Help simplifying a filtering/highlighting code 

    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
    Reply With QuoteRegister To Reply
  4. 03-17-2016, 08:46 AM #4
    BG1983
    BG1983 is offline
    Forum Contributor
    Join Date
    08-08-2015
    Location
    North Carolina USA
    MS-Off Ver
    MS Office 2016
    Posts
    368

    Re: Help simplifying a filtering/highlighting code

    I put the code/code thing on there. I will try again.
    Reply With QuoteRegister To Reply
+ Reply to Thread
« Previous Thread | Next Thread »

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Need help simplifying vba code
    By Zimmerman in forum Excel Programming / VBA / Macros
    Replies: 6
    Last Post: 11-19-2015, 02:22 PM
  2. [SOLVED] New to VBA need help with simplifying code.
    By ntsun in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 09-24-2014, 09:11 AM
  3. Pivot Tables Filtering (Help in simplifying macro from record)
    By arersando in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 03-20-2014, 09:01 AM
  4. [SOLVED] Help in simplifying code
    By RaquelAR in forum Excel Programming / VBA / Macros
    Replies: 6
    Last Post: 11-17-2013, 02:04 PM
  5. Simplifying the code
    By walid66 in forum Excel Programming / VBA / Macros
    Replies: 7
    Last Post: 03-20-2008, 07:53 PM
  6. Simplifying code
    By T De Villiers in forum Excel Programming / VBA / Macros
    Replies: 4
    Last Post: 02-23-2007, 06:50 AM
  7. Simplifying VB code
    By odggi in forum Excel Programming / VBA / Macros
    Replies: 6
    Last Post: 09-30-2006, 07:09 AM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Forum Rules


Search Engine Friendly URLs by vBSEO 3.6.0 RC 1