Using Date in InputBox for criteria in code

I have the following code:

Sub ShadeCells()

Dim dblSum As Double
Dim cell As Range
On Error GoTo Errhandler:
dblSum = 0
With ActiveSheet.Range("A:A")
For Each cell In .Range("D:D")
If cell.Text <> "" Then
If cell.Value <= DateValue("2/08/2005") Then
cell.Offset(0, 1).Interior.ColorIndex = 16
If IsNumeric(cell.Offset(0, 1)) Then
dblSum = dblSum + cell.Offset(0, 1).Value
End If
Else
cell.Offset(0, 1).Interior.ColorIndex = xlNone
End If
Else
cell.Offset(0, 1).Interior.ColorIndex = xlNone
End If
Next
Application.EnableEvents = False

.Range("G1").Value = dblSum
.Font.Bold = True
.NumberFormat = "$#,##0.00"

Application.EnableEvents = True
End With
Errhandler:
Application.EnableEvents = True
End Sub

Works great, now instead of going in and changing the date every 2 weeks
(this is how often I use this code) I would like an InputBox come up and ask
for the date to use and then use that entry in the criteria section:

If cell.Value <= DateValue("2/08/2005") Then

Any suggestions would be great, Thanks!

Why bother with an input box?

You could use the Date statement in VBA to work out the criteria.

Try something like

Dim S As String
S = InputBox("Enter A Date")
If S = "" Then
Exit Sub
End If
' your code
If cell.Value <= DateValue(S) Then
' your code


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com




"SMac" <[email protected]> wrote in message
news:[email protected]...
>I have the following code:
>
> Sub ShadeCells()
>
> Dim dblSum As Double
> Dim cell As Range
> On Error GoTo Errhandler:
> dblSum = 0
> With ActiveSheet.Range("A:A")
> For Each cell In .Range("D:D")
> If cell.Text <> "" Then
> If cell.Value <= DateValue("2/08/2005") Then
> cell.Offset(0, 1).Interior.ColorIndex = 16
> If IsNumeric(cell.Offset(0, 1)) Then
> dblSum = dblSum + cell.Offset(0, 1).Value
> End If
> Else
> cell.Offset(0, 1).Interior.ColorIndex = xlNone
> End If
> Else
> cell.Offset(0, 1).Interior.ColorIndex = xlNone
> End If
> Next
> Application.EnableEvents = False
>
> .Range("G1").Value = dblSum
> .Font.Bold = True
> .NumberFormat = "$#,##0.00"
>
> Application.EnableEvents = True
> End With
> Errhandler:
> Application.EnableEvents = True
> End Sub
>
> Works great, now instead of going in and changing the date
> every 2 weeks
> (this is how often I use this code) I would like an InputBox
> come up and ask
> for the date to use and then use that entry in the criteria
> section:
>
> If cell.Value <= DateValue("2/08/2005") Then
>
> Any suggestions would be great, Thanks!

Sub ShadeCells()
Dim dblSum As Double
Dim cell As Range
Dim strAnswer As String '<==== added

On Error GoTo Errhandler:
strAnswer = _
Application.InputBox(Prompt:="Enter Date: ", _
Title:="Use format mm/dd/yyyy...", _
Default:=today(), Type:=2) '<==== added

dblSum = 0
With ActiveSheet.Range("A:A")
For Each cell In .Range("D:D")
If cell.Text < "" Then
If cell.Value <= DateValue(strAnswer) Then '<==== changed

HTH,
Gary Brown


"SMac" wrote:

> I have the following code:
>
> Sub ShadeCells()
>
> Dim dblSum As Double
> Dim cell As Range
> On Error GoTo Errhandler:
> dblSum = 0
> With ActiveSheet.Range("A:A")
> For Each cell In .Range("D:D")
> If cell.Text <> "" Then
> If cell.Value <= DateValue("2/08/2005") Then
> cell.Offset(0, 1).Interior.ColorIndex = 16
> If IsNumeric(cell.Offset(0, 1)) Then
> dblSum = dblSum + cell.Offset(0, 1).Value
> End If
> Else
> cell.Offset(0, 1).Interior.ColorIndex = xlNone
> End If
> Else
> cell.Offset(0, 1).Interior.ColorIndex = xlNone
> End If
> Next
> Application.EnableEvents = False
>
> .Range("G1").Value = dblSum
> .Font.Bold = True
> .NumberFormat = "$#,##0.00"
>
> Application.EnableEvents = True
> End With
> Errhandler:
> Application.EnableEvents = True
> End Sub
>
> Works great, now instead of going in and changing the date every 2 weeks
> (this is how often I use this code) I would like an InputBox come up and ask
> for the date to use and then use that entry in the criteria section:
>
> If cell.Value <= DateValue("2/08/2005") Then
>
> Any suggestions would be great, Thanks!

oops...
s/b
strAnswer = _
Application.InputBox(Prompt:="Enter Date: ", _
Title:="Use format mm/dd/yyyy...", _
Default:=Format(Now, "mm/dd/yyyy"), Type:=2)

Today doesn't work in vba, changed to Format(Now, "mm/dd/yyyy")

"Gary Brown" wrote:

> Sub ShadeCells()
> Dim dblSum As Double
> Dim cell As Range
> Dim strAnswer As String '<==== added
>
> On Error GoTo Errhandler:
> strAnswer = _
> Application.InputBox(Prompt:="Enter Date: ", _
> Title:="Use format mm/dd/yyyy...", _
> Default:=today(), Type:=2) '<==== added
>
> dblSum = 0
> With ActiveSheet.Range("A:A")
> For Each cell In .Range("D:D")
> If cell.Text < "" Then
> If cell.Value <= DateValue(strAnswer) Then '<==== changed
>
> HTH,
> Gary Brown
>
>
> "SMac" wrote:
>
> > I have the following code:
> >
> > Sub ShadeCells()
> >
> > Dim dblSum As Double
> > Dim cell As Range
> > On Error GoTo Errhandler:
> > dblSum = 0
> > With ActiveSheet.Range("A:A")
> > For Each cell In .Range("D:D")
> > If cell.Text <> "" Then
> > If cell.Value <= DateValue("2/08/2005") Then
> > cell.Offset(0, 1).Interior.ColorIndex = 16
> > If IsNumeric(cell.Offset(0, 1)) Then
> > dblSum = dblSum + cell.Offset(0, 1).Value
> > End If
> > Else
> > cell.Offset(0, 1).Interior.ColorIndex = xlNone
> > End If
> > Else
> > cell.Offset(0, 1).Interior.ColorIndex = xlNone
> > End If
> > Next
> > Application.EnableEvents = False
> >
> > .Range("G1").Value = dblSum
> > .Font.Bold = True
> > .NumberFormat = "$#,##0.00"
> >
> > Application.EnableEvents = True
> > End With
> > Errhandler:
> > Application.EnableEvents = True
> > End Sub
> >
> > Works great, now instead of going in and changing the date every 2 weeks
> > (this is how often I use this code) I would like an InputBox come up and ask
> > for the date to use and then use that entry in the criteria section:
> >
> > If cell.Value <= DateValue("2/08/2005") Then
> >
> > Any suggestions would be great, Thanks!

Date does though.

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Gary Brown" <[email protected]> wrote in message
news:[email protected]...
> oops...
> s/b
> strAnswer = _
> Application.InputBox(Prompt:="Enter Date: ", _
> Title:="Use format mm/dd/yyyy...", _
> Default:=Format(Now, "mm/dd/yyyy"), Type:=2)
>
> Today doesn't work in vba, changed to Format(Now, "mm/dd/yyyy")
>
> "Gary Brown" wrote:
>
> > Sub ShadeCells()
> > Dim dblSum As Double
> > Dim cell As Range
> > Dim strAnswer As String '<==== added
> >
> > On Error GoTo Errhandler:
> > strAnswer = _
> > Application.InputBox(Prompt:="Enter Date: ", _
> > Title:="Use format mm/dd/yyyy...", _
> > Default:=today(), Type:=2) '<==== added
> >
> > dblSum = 0
> > With ActiveSheet.Range("A:A")
> > For Each cell In .Range("D:D")
> > If cell.Text < "" Then
> > If cell.Value <= DateValue(strAnswer) Then '<==== changed
> >
> > HTH,
> > Gary Brown
> >
> >
> > "SMac" wrote:
> >
> > > I have the following code:
> > >
> > > Sub ShadeCells()
> > >
> > > Dim dblSum As Double
> > > Dim cell As Range
> > > On Error GoTo Errhandler:
> > > dblSum = 0
> > > With ActiveSheet.Range("A:A")
> > > For Each cell In .Range("D:D")
> > > If cell.Text <> "" Then
> > > If cell.Value <= DateValue("2/08/2005") Then
> > > cell.Offset(0, 1).Interior.ColorIndex = 16
> > > If IsNumeric(cell.Offset(0, 1)) Then
> > > dblSum = dblSum + cell.Offset(0, 1).Value
> > > End If
> > > Else
> > > cell.Offset(0, 1).Interior.ColorIndex = xlNone
> > > End If
> > > Else
> > > cell.Offset(0, 1).Interior.ColorIndex = xlNone
> > > End If
> > > Next
> > > Application.EnableEvents = False
> > >
> > > .Range("G1").Value = dblSum
> > > .Font.Bold = True
> > > .NumberFormat = "$#,##0.00"
> > >
> > > Application.EnableEvents = True
> > > End With
> > > Errhandler:
> > > Application.EnableEvents = True
> > > End Sub
> > >
> > > Works great, now instead of going in and changing the date every 2
weeks
> > > (this is how often I use this code) I would like an InputBox come up
and ask
> > > for the date to use and then use that entry in the criteria section:
> > >
> > > If cell.Value <= DateValue("2/08/2005") Then
> > >
> > > Any suggestions would be great, Thanks!

Ohhhhhhhhhh, be quite ;O>

Why go with something nice and simple like that when you can get real
complicated? :O>

Thanks for the note.
Gary


"Bob Phillips" wrote:

> Date does though.
>
> --
>
> HTH
>
> RP
> (remove nothere from the email address if mailing direct)
>
>
> "Gary Brown" <[email protected]> wrote in message
> news:[email protected]...
> > oops...
> > s/b
> > strAnswer = _
> > Application.InputBox(Prompt:="Enter Date: ", _
> > Title:="Use format mm/dd/yyyy...", _
> > Default:=Format(Now, "mm/dd/yyyy"), Type:=2)
> >
> > Today doesn't work in vba, changed to Format(Now, "mm/dd/yyyy")
> >
> > "Gary Brown" wrote:
> >
> > > Sub ShadeCells()
> > > Dim dblSum As Double
> > > Dim cell As Range
> > > Dim strAnswer As String '<==== added
> > >
> > > On Error GoTo Errhandler:
> > > strAnswer = _
> > > Application.InputBox(Prompt:="Enter Date: ", _
> > > Title:="Use format mm/dd/yyyy...", _
> > > Default:=today(), Type:=2) '<==== added
> > >
> > > dblSum = 0
> > > With ActiveSheet.Range("A:A")
> > > For Each cell In .Range("D:D")
> > > If cell.Text < "" Then
> > > If cell.Value <= DateValue(strAnswer) Then '<==== changed
> > >
> > > HTH,
> > > Gary Brown
> > >
> > >
> > > "SMac" wrote:
> > >
> > > > I have the following code:
> > > >
> > > > Sub ShadeCells()
> > > >
> > > > Dim dblSum As Double
> > > > Dim cell As Range
> > > > On Error GoTo Errhandler:
> > > > dblSum = 0
> > > > With ActiveSheet.Range("A:A")
> > > > For Each cell In .Range("D:D")
> > > > If cell.Text <> "" Then
> > > > If cell.Value <= DateValue("2/08/2005") Then
> > > > cell.Offset(0, 1).Interior.ColorIndex = 16
> > > > If IsNumeric(cell.Offset(0, 1)) Then
> > > > dblSum = dblSum + cell.Offset(0, 1).Value
> > > > End If
> > > > Else
> > > > cell.Offset(0, 1).Interior.ColorIndex = xlNone
> > > > End If
> > > > Else
> > > > cell.Offset(0, 1).Interior.ColorIndex = xlNone
> > > > End If
> > > > Next
> > > > Application.EnableEvents = False
> > > >
> > > > .Range("G1").Value = dblSum
> > > > .Font.Bold = True
> > > > .NumberFormat = "$#,##0.00"
> > > >
> > > > Application.EnableEvents = True
> > > > End With
> > > > Errhandler:
> > > > Application.EnableEvents = True
> > > > End Sub
> > > >
> > > > Works great, now instead of going in and changing the date every 2
> weeks
> > > > (this is how often I use this code) I would like an InputBox come up
> and ask
> > > > for the date to use and then use that entry in the criteria section:
> > > >
> > > > If cell.Value <= DateValue("2/08/2005") Then
> > > >
> > > > Any suggestions would be great, Thanks!
>
>
>

LOL!

"Gary Brown" <[email protected]> wrote in message
news:[email protected]...
> Ohhhhhhhhhh, be quite ;O>
>
> Why go with something nice and simple like that when you can get real
> complicated? :O>
>
> Thanks for the note.
> Gary
>
>
> "Bob Phillips" wrote:
>
> > Date does though.
> >