Using Date in InputBox for criteria in code
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" wrote in message
...
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!
|