Hi all,

Does anyone know how to ensure that a textbox can only be input into as
date format?, ive seen boxes that already have the slashes in them and
it automatically moves you past the slash when you type, like DD/MM/YY
and the box always looks like / /

The only reason i ask is that I spent some time a while back getting
help from someone to convert the date input into the textbox as
previously it converted into MM/DD/YYYY for some unknown reason and now
that it is looking for it to be a certain format it breaks the code if
letters are put in there. This is why i wonder if you can MAKE the user
put it in right?
(ill paste my full sub below)

Many thanks in advance

Duncan


Private Sub CommandButton1_Click()

Sheets("sheet1").Select
If Date1t.Value <= "" Then
Exit Sub
End If
If Date2t.Value <= "" Then
Exit Sub
End If


Dim Date1 As Date, Date2 As Date
' breaks here if input is not correct format or is not numeric
Date1 = Format(Date1t.Text, "DD/MM/yyyy")
Date2 = Format(Date2t.Text, "DD/MM/yyyy")

Range("D1").End(xlDown).Offset(1, 0).Select
ActiveCell.Select

Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="=" & CLng(Date1),
Operator:=xlAnd _
, Criteria2:="<=" & CLng(Date2)

LOPRdaterange.Hide

Select Case MsgBox("Print?", vbYesNo)
Case vbYes
'will put something here to print out the sheet
Sheet1.Activate
Set rng = Range("A1:I" & Range("a65536").End(xlUp).Row)
rng.Select
Selection.PrintOut Copies:=1, Collate:=True


With Worksheets("Sheet1")
Set rng = Intersect(.AutoFilter.Range, .Columns(7))
s = Application.Subtotal(9, rng)
MsgBox s
LOPRtot.Value = s
End With


With Worksheets("Sheet1")
Set rng = Intersect(.AutoFilter.Range, .Columns(8))
s2 = Application.Subtotal(9, rng)
MsgBox s2
LOPRus.Value = s2
End With


'With Worksheets("Sheet1")
'Lastrow = .Cells(Rows.Count, "G").End(xlUp).Row
's = 0
'For i = 2 To Lastrow
'If .Rows(i).Hidden = False Then s = s + .Cells(i, "G")
'Next i
'End With
'LOPRtot.Value = s

'With Worksheets("Sheet1")
'Lastrow2 = .Cells(Rows.Count, "H").End(xlUp).Row
's2 = 0
'For j = 2 To Lastrow2
'If .Rows(j).Hidden = False Then s2 = s2 + .Cells(j, "H")
'Next j
'End With
'LOPRus.Value = s2

Selection.AutoFilter
LOPRdaterange.Show
Exit Sub

Case vbNo

'will replicate the above here so it still populates the form with
figures
With Worksheets("Sheet1")
Lastrow = .Cells(Rows.Count, "G").End(xlUp).Row
s = 0
For i = 2 To Lastrow
If .Rows(i).Hidden = False Then s = s + .Cells(i, "G")
Next i
End With
LOPRtot.Value = s

With Worksheets("Sheet1")
Lastrow2 = .Cells(Rows.Count, "H").End(xlUp).Row
s2 = 0
For j = 2 To Lastrow2
If .Rows(j).Hidden = False Then s2 = s2 + .Cells(j, "H")
Next j
End With
LOPRus.Value = s2

Selection.AutoFilter
LOPRdaterange.Show

Exit Sub
End Select


Sheets("sheet1").Select

End Sub

"the date input into the textbox as previously it converted into MM/DD/YYYY
for some unknown reason ..."

If you explicitly assign the contents (a date) of an InputBox to a variable
declared as a date, the format of the date assigned reverts to the data
format set in Regional Settings.

"Duncan" wrote:

Hi all,

Does anyone know how to ensure that a textbox can only be input into as
date format?, ive seen boxes that already have the slashes in them and
it automatically moves you past the slash when you type, like DD/MM/YY
and the box always looks like / /

The only reason i ask is that I spent some time a while back getting
help from someone to convert the date input into the textbox as
previously it converted into MM/DD/YYYY for some unknown reason and now
that it is looking for it to be a certain format it breaks the code if
letters are put in there. This is why i wonder if you can MAKE the user
put it in right?
(ill paste my full sub below)

Many thanks in advance

Duncan


Private Sub CommandButton1_Click()

Sheets("sheet1").Select
If Date1t.Value <= "" Then
Exit Sub
End If
If Date2t.Value <= "" Then
Exit Sub
End If


Dim Date1 As Date, Date2 As Date
' breaks here if input is not correct format or is not numeric
Date1 = Format(Date1t.Text, "DD/MM/yyyy")
Date2 = Format(Date2t.Text, "DD/MM/yyyy")

Range("D1").End(xlDown).Offset(1, 0).Select
ActiveCell.Select

Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="=" & CLng(Date1),
Operator:=xlAnd _
, Criteria2:="<=" & CLng(Date2)

LOPRdaterange.Hide

Select Case MsgBox("Print?", vbYesNo)
Case vbYes
'will put something here to print out the sheet
Sheet1.Activate
Set rng = Range("A1:I" & Range("a65536").End(xlUp).Row)
rng.Select
Selection.PrintOut Copies:=1, Collate:=True


With Worksheets("Sheet1")
Set rng = Intersect(.AutoFilter.Range, .Columns(7))
s = Application.Subtotal(9, rng)
MsgBox s
LOPRtot.Value = s
End With


With Worksheets("Sheet1")
Set rng = Intersect(.AutoFilter.Range, .Columns(8))
s2 = Application.Subtotal(9, rng)
MsgBox s2
LOPRus.Value = s2
End With


'With Worksheets("Sheet1")
'Lastrow = .Cells(Rows.Count, "G").End(xlUp).Row
's = 0
'For i = 2 To Lastrow
'If .Rows(i).Hidden = False Then s = s + .Cells(i, "G")
'Next i
'End With
'LOPRtot.Value = s

'With Worksheets("Sheet1")
'Lastrow2 = .Cells(Rows.Count, "H").End(xlUp).Row
's2 = 0
'For j = 2 To Lastrow2
'If .Rows(j).Hidden = False Then s2 = s2 + .Cells(j, "H")
'Next j
'End With
'LOPRus.Value = s2

Selection.AutoFilter
LOPRdaterange.Show
Exit Sub

Case vbNo

'will replicate the above here so it still populates the form with
figures
With Worksheets("Sheet1")
Lastrow = .Cells(Rows.Count, "G").End(xlUp).Row
s = 0
For i = 2 To Lastrow
If .Rows(i).Hidden = False Then s = s + .Cells(i, "G")
Next i
End With
LOPRtot.Value = s

With Worksheets("Sheet1")
Lastrow2 = .Cells(Rows.Count, "H").End(xlUp).Row
s2 = 0
For j = 2 To Lastrow2
If .Rows(j).Hidden = False Then s2 = s2 + .Cells(j, "H")
Next j
End With
LOPRus.Value = s2

Selection.AutoFilter
LOPRdaterange.Show

Exit Sub
End Select


Sheets("sheet1").Select

End Sub

The textboxes in Excel do not support what you describe. You need to adapt
your code to check before making assumptions:

if isdate(Date1t.Text) then
Date1 = cdate(Date1t.Text)
else
msgbox "Bad date"
Date1t.Text = ""
exit sub
end if
if isdate(Date2t.Text) then
Date2 = cdate(Date2t.Text)
else
msgbox "Bad Date"
Date2t.Text
exit sub
End if


This approach will allow you to accept a date in any format and interpret it
correctly as long as it conforms to regional settings.

--
Regards,
Tom Ogilvy


"Duncan" wrote:

Hi all,

Does anyone know how to ensure that a textbox can only be input into as
date format?, ive seen boxes that already have the slashes in them and
it automatically moves you past the slash when you type, like DD/MM/YY
and the box always looks like / /

The only reason i ask is that I spent some time a while back getting
help from someone to convert the date input into the textbox as
previously it converted into MM/DD/YYYY for some unknown reason and now
that it is looking for it to be a certain format it breaks the code if
letters are put in there. This is why i wonder if you can MAKE the user
put it in right?
(ill paste my full sub below)

Many thanks in advance

Duncan


Private Sub CommandButton1_Click()

Sheets("sheet1").Select
If Date1t.Value <= "" Then
Exit Sub
End If
If Date2t.Value <= "" Then
Exit Sub
End If


Dim Date1 As Date, Date2 As Date
' breaks here if input is not correct format or is not numeric
Date1 = Format(Date1t.Text, "DD/MM/yyyy")
Date2 = Format(Date2t.Text, "DD/MM/yyyy")

Range("D1").End(xlDown).Offset(1, 0).Select
ActiveCell.Select

Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="=" & CLng(Date1),
Operator:=xlAnd _
, Criteria2:="<=" & CLng(Date2)

LOPRdaterange.Hide

Select Case MsgBox("Print?", vbYesNo)
Case vbYes
'will put something here to print out the sheet
Sheet1.Activate
Set rng = Range("A1:I" & Range("a65536").End(xlUp).Row)
rng.Select
Selection.PrintOut Copies:=1, Collate:=True


With Worksheets("Sheet1")
Set rng = Intersect(.AutoFilter.Range, .Columns(7))
s = Application.Subtotal(9, rng)
MsgBox s
LOPRtot.Value = s
End With


With Worksheets("Sheet1")
Set rng = Intersect(.AutoFilter.Range, .Columns(8))
s2 = Application.Subtotal(9, rng)
MsgBox s2
LOPRus.Value = s2
End With


'With Worksheets("Sheet1")
'Lastrow = .Cells(Rows.Count, "G").End(xlUp).Row
's = 0
'For i = 2 To Lastrow
'If .Rows(i).Hidden = False Then s = s + .Cells(i, "G")
'Next i
'End With
'LOPRtot.Value = s

'With Worksheets("Sheet1")
'Lastrow2 = .Cells(Rows.Count, "H").End(xlUp).Row
's2 = 0
'For j = 2 To Lastrow2
'If .Rows(j).Hidden = False Then s2 = s2 + .Cells(j, "H")
'Next j
'End With
'LOPRus.Value = s2

Selection.AutoFilter
LOPRdaterange.Show
Exit Sub

Case vbNo

'will replicate the above here so it still populates the form with
figures
With Worksheets("Sheet1")
Lastrow = .Cells(Rows.Count, "G").End(xlUp).Row
s = 0
For i = 2 To Lastrow
If .Rows(i).Hidden = False Then s = s + .Cells(i, "G")
Next i
End With
LOPRtot.Value = s

With Worksheets("Sheet1")
Lastrow2 = .Cells(Rows.Count, "H").End(xlUp).Row
s2 = 0
For j = 2 To Lastrow2
If .Rows(j).Hidden = False Then s2 = s2 + .Cells(j, "H")
Next j
End With
LOPRus.Value = s2

Selection.AutoFilter
LOPRdaterange.Show

Exit Sub
End Select


Sheets("sheet1").Select

End Sub

Thanks Tom,

Works a treat!

Duncan

The only other thing, seems like a stupid question, can you get it to
recognise a date seperated by dots? (18.04.06)

Assuming xl2000 or later:

Dim s1 as String, s2 as String
s1 = Date1t.text
s2 = Date2t.text
s1 = Replace(s1,".","/")
s2 = Repalce(s2,".","/")

if isdate(s1) then
Date1 = cdate(s1)
else
msgbox "Bad date"
Date1t.Text = ""
exit sub
end if
if isdate(s2) then
Date2 = cdate(s2)
else
msgbox "Bad Date"
Date2t.Text
exit sub
End if

--
Regards,
Tom Ogilvy


"Duncan" wrote:

The only other thing, seems like a stupid question, can you get it to
recognise a date seperated by dots? (18.04.06)

Thank you Tom,

Works a treat.


Cheers

Duncan