Select rows equal to filter and highlight row

[JohnM]

Hi,
Thanks in advance, this site has been invaluable to me!
I am trying to pick out rows after a certain date, then highlight them so
they are plainly visible when looking at the entire spreadsheet. The code
below seems to do this, but when you remove the filter, all of the rows are
highlighted. If I manually go in and sort, then highlight individual rows,
and remove the filter, it works.

Sub MarkNewPlayers()

Dim afterDate As String
Dim myDate As String
Dim wrksMain As Worksheet
Dim lastRow As String
Set wrksMain = Worksheets("PlDetails")
wrksMain.Select

' Message Box opens to enter the Date to use in the file name
myDate = InputBox("Please enter your date in mm/dd/yyyy format:", "What
date do you want to enter?", "mm/dd/yyyy")
' Highlight dates after the date that is entered
If myDate = "" Or Not IsDate(myDate) Then
MsgBox "You did not enter a date.", 48, "Action cancelled."
Exit Sub
Else
afterDate = myDate
End If
' select all cells, then set filter
' Cells.Select
' Selection.AutoFilter
' find last row number
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
' for testing
MsgBox lastRow
' sort spreadsheet on applicaton date - column D
ActiveSheet.Range("$A$1:$AL$" & lastRow).AutoFilter Field:=4,
Criteria1:=">" & afterDate, Operator:=xlAnd
With ActiveWorkbook.Worksheets("PlDetails").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' set selection to column D row 2
Range("D2").Select
' loop to pick rows to highlight
Do
If ActiveCell.Value >= afterDate Then
' Set "RowNum" to the active row, then select row
rowNum = ActiveCell.Row
Range("A" & rowNum & ":AL" & rowNum).Select
' Green Background Fill
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
' ActiveWindow.DisplayGridlines = True

' Below changes active cell back to RowNum, Column 3
ActiveCell.Offset(1, 3).Select
' Else moves from active cell down 1 row
Else: ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell)

ActiveSheet.Range("$A$1:$AL$" & lastRow).AutoFilter Field:=4

End Sub

 

[OssieMac]

Hi John,

I haven't tried to interpret exactly what your code is doing but the
following example demonstrates how to apply color to just the visible cells
in a filtered range.

In the line of code Set rngFiltered the Offset moves it down one row off the
column headers.
The resize reduces it by one row otherwise have an extra row on bottom after
moving down one row off column headers.
SpecialCells(xlCellTypeVisible) is self explanatary.

Sub VisibleCellsDemo()

Dim rngFiltered As Range

With Sheets("Sheet1").AutoFilter.Range
Set rngFiltered = .Offset(1, 0) _
.Resize(.Rows.Count - 1, .Columns.Count) _
.SpecialCells(xlCellTypeVisible)
End With

rngFiltered.Interior.ColorIndex = 6

End Sub

 

[OssieMac]

Hi again John,

I was short on time earlier but I have now had a closer look at your code
and if I am interpreting correctly what you want to do then I think it should
be more like the following. Note that I have removed existing filters and
cleared any existing interior formatting before setting the filter again and
setting the interior color of the visible cells.

Sub MarkNewPlayers()

Dim afterDate As String
Dim myDate As String
Dim wrksMain As Worksheet
Dim lastRow As String
Dim rngFiltered As Range

Set wrksMain = Worksheets("PlDetails")

' Message Box opens to enter the Date to use in the file name
myDate = InputBox _
("Please enter your date in mm/dd/yyyy format:", _
"What date do you want to enter?", "mm/dd/yyyy")

If myDate = "" Or Not IsDate(myDate) Then
MsgBox "You did not enter a date.", 48, "Action cancelled."
Exit Sub
Else
afterDate = myDate
End If

lastRow = Cells(Rows.Count, 1).End(xlUp).Row

'Clear existing filters (if any)
With wrksMain
If .AutoFilterMode Then
If .FilterMode Then
.ShowAllData
End If
End If
End With

'Clear existing interior colors
With wrksMain.Range("$A$1:$AL$" & lastRow).Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With

'Set AutoFilter on Field 4
wrksMain.Range("$A$1:$AL$" & lastRow) _
.AutoFilter Field:=4, _
Criteria1:=">" & afterDate

'Set rngFiltered to just the visible cells
With wrksMain.AutoFilter.Range
Set rngFiltered = .Offset(1, 0) _
.Resize(.Rows.Count - 1, .Columns.Count) _
.SpecialCells(xlCellTypeVisible)
End With

'Set interior color of visible cells
With rngFiltered.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With

End Sub

 

[OssieMac]

One last thing John,

Replace the following line of code
lastRow = Cells(Rows.Count, 1).End(xlUp).Row

with the following 3 lines of code
With wrksMain
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
End With

Reason for the above is that the line of code on its own will work while
PlDetails is the active sheet but the replacement code will allow you to have
any sheet active and still run the code for PlDetails. Basically more
professional.

My apologies for my previous omission.

 

[JohnM]

OssieMac,

Thanks for all of the suggestions! The last two did the trick just with a
copy and paste from your post. I am sure the first one would have helped me
in the right direction, had I been working on it at the time you posted it. I
do appreciate the "more professional" adjustment. I started this VBA with
just recording Macros and I am trying to clean them up and make them more
"general" with variables and such to make them work in other instances.

Thanks again!