Consulting

Results 1 to 6 of 6

Thread: Color fill when >= date entered

  1. #1
    VBAX Regular
    Joined
    Jun 2007
    Posts
    20
    Location

    Color fill when >= date entered

    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?

    [vba]
    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
    [/vba]

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    [vba]

    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
    [/vba]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    VBAX Regular
    Joined
    Jun 2007
    Posts
    20
    Location
    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?

    [VBA]
    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
    [/VBA]

  4. #4
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    Doesn't it do that already?
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  5. #5
    VBAX Regular
    Joined
    Jun 2007
    Posts
    20
    Location
    When it hits the last sheet and completes the loop, I get an "Object Variable or With block variable not set."

  6. #6
    VBAX Expert
    Joined
    Feb 2005
    Location
    Nanaimo, British Columbia, Cananda
    Posts
    568
    Location
    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:
    [vba]
    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
    [/vba]
    Cheers,

    dr

    "Questions, help and advice for free, small projects by donation. large projects by quote"

    http:\\www.ExcelVBA.joellerabu.com

Posting Permissions

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