PDA

View Full Version : Color fill when >= date entered



kilbey1
09-24-2008, 01:42 PM
I've set up this macro that prompts the user for a date, then highlights the rows when it's found in a particular cell. Simple enough.

Can someone please point me in the right direction so I can do the same, except highlight all cells that are >= the date entered?


Sub findDate()
Dim rFound As Range
Dim strDate As String
Dim strFirstAddress As String
Dim lReply As Long

strDate = Application.InputBox(Prompt:="Please Enter Beginning Date to Locate:", Title:="DATE FIND", Default:=Format(Date, "Short Date"), Type:=2)
'cancel
If strDate = "False" Then Exit Sub

If IsDate(strDate) Then
Rows.Interior.ColorIndex = 0
With ActiveSheet.Range("C:C")
Set rFound = .Find(What:=CDate(strDate), LookIn:=xlValues)
If Not rFound Is Nothing Then
strFirstAddress = rFound.Address
Do
rFound.EntireRow.Interior.ColorIndex = 6
Set rFound = .FindNext(rFound)
Loop While Not rFound Is Nothing And rFound.Address <> strFirstAddress
Else
If rFound Is Nothing Then
lReply = MsgBox("Date cannot be found. Try Again?", vbYesNo)
If lReply = vbYes Then Run "findDate":
End If
End If
End With
'Else
' MsgBox "Invalid Date", vbExclamation
End If
End Sub

Bob Phillips
09-24-2008, 02:37 PM
Sub findDate()
Dim rFound As Range
Dim strDate As String
Dim strFirstAddress As String
Dim LastRow As Long
Dim i As Long

strDate = Application.InputBox(Prompt:="Please Enter Beginning Date to Locate:", _
Title:="DATE FIND", _
Default:=Format(Date, "Short Date"), Type:=2)
'cancel
If strDate = "False" Then Exit Sub

If IsDate(strDate) Then

Rows.Interior.ColorIndex = xlColorIndexNone
LastRow = Cells(Rows.Count, "C").End(xlUp).Row
For i = 1 To LastRow

If Cells(i, "C").Value >= CDate(strDate) Then

Rows(i).Interior.ColorIndex = 6
End If
Next i
End If
End Sub

kilbey1
09-24-2008, 03:26 PM
Works great; I just change i = 1 to i = 2 because it changed my header. I changed it to go through multiple spreadsheets; what function should I look at to end the for next at the last worksheet?


Sub findDate()
Dim rFound As Range
Dim strDate As String
Dim strFirstAddress As String
Dim LastRow As Long
Dim i As Long

strDate = Application.InputBox(Prompt:="Please Enter Beginning Date to Locate:", _
Title:="DATE FIND", Default:=Format(Date, "Short Date"), Type:=2)
'cancel
If strDate = "False" Then Exit Sub

If IsDate(strDate) Then

For Each ws In ActiveWorkbook.Worksheets

Rows.Interior.ColorIndex = xlColorIndexNone
LastRow = Cells(Rows.Count, "C").End(xlUp).Row
For i = 2 To LastRow

If Cells(i, "C").Value >= CDate(strDate) Then

Rows(i).Interior.ColorIndex = 6
End If
Next i

ActiveSheet.Next.Select
Next

End If
End Sub

Bob Phillips
09-24-2008, 03:36 PM
Doesn't it do that already?

kilbey1
09-24-2008, 03:41 PM
When it hits the last sheet and completes the loop, I get an "Object Variable or With block variable not set."

rbrhodes
09-24-2008, 07:33 PM
Perhaps a previous version of Excel? Note: it chokes for me as well on the last sheet, then if try to run it again it chokes onthe first one! Try this revision:

Sub findDate()
Dim rFound As Range
Dim strDate As String
Dim strFirstAddress As String
Dim LastRow As Long
Dim i As Long

strDate = Application.InputBox(Prompt:="Please Enter Beginning Date to Locate:", _
Title:="DATE FIND", Default:=Format(Date, "Short Date"), Type:=2)
'cancel
If strDate = "False" Then Exit Sub

If IsDate(strDate) Then

For Each ws In ActiveWorkbook.Worksheets

'//Added with to replace NEXT statement

With ws
.Rows.Interior.ColorIndex = xlColorIndexNone
LastRow = .Cells(Rows.Count, "C").End(xlUp).Row
For i = 2 To LastRow
If .Cells(i, "C").Value >= CDate(strDate) Then
.Rows(i).Interior.ColorIndex = 6
End If
Next i
'//Cut NEXT statement, close the added With
End With
Next

End If
End Sub