Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 155
Default User Date Picker rather than Input Box

Hi all

I have been using the following code to run a Daily Report. The input box
asks the user to enter a date, and the sheet uses the date entered to update
the sheet values.

Question: I want to use a date picker instead of an input box to enter a
date to update the values on the 'Daily Report' sheet. If there is no
information for the date, then display a message that says 'No data for date'

My date picker control is called dtpDailyReport. How can i accomplish this?

Public Sub PrepareDailyReport()
Const sourceSheet = "Daily Reading Master Log"
Const mapSheet = "ColumnsMap"
Dim userInput As Variant
Dim reportDate As Date
Dim searchRange As Range
Dim foundRange As Range
Dim searchAddress As String
Dim anyCell As Object
Dim sourceRow As Long

Application.ScreenUpdating = False
'we use this as a test to see if this can even be done
On Error Resume Next
searchAddress = "B1:" & Worksheets(sourceSheet).Range("B" &
Rows.Count).End(xlUp).Address
If Err < 0 Then
'couldn't find the sheet, don't do anything
'they have either renamed the other sheet, OR
'more likely, this sheet has been emailed
'all by itself to them.
Err.Clear
On Error GoTo 0
Exit Sub
End If
On Error GoTo 0 ' clear error trapping
' if it did not error out, then sheet 'sourceSheet' must be in
' the workbook with this sheet/code, so it should work.

userInput = InputBox("Enter Date for the Report - MM/DD/YYYY, Ex.Mar 1,
2007", "Report Date", "")
If userInput = "" Or Not (IsDate(userInput)) Then
Exit Sub
End If
reportDate = CDate(userInput)
Set searchRange = Worksheets(sourceSheet).Range(searchAddress)
'prepare the report
Worksheets(Me.Name).Activate
Range("rptDate") = reportDate
For Each anyCell In searchRange
If anyCell.Value = reportDate Then
Set foundRange = anyCell
Exit For ' quit looking
End If
Next
If foundRange Is Nothing Then
MsgBox "Date not matched. No Report Generated."
Exit Sub
End If
On Error GoTo ExitDailyReporter
'save the row number where our data is
sourceRow = foundRange.Row
'now copy the data
'rptPLSTreated
'srcPLSTreated
Range("rptPLSTreated") = _

Worksheets(sourceSheet).Range(Worksheets(mapSheet) .Range("srcPLSTreated").Value & sourceRow).Value
'rptPlantUtilization
'srcPlantUtilization
Range("rptPlantUtilization") = _

Worksheets(sourceSheet).Range(Worksheets(mapSheet) .Range("srcPlantUtilization").Value & sourceRow).Value
'rptMechAvail
'srcMechAvail
Range("rptMechAvail") = _

Worksheets(sourceSheet).Range(Worksheets(mapSheet) .Range("srcMechAvail").Value & sourceRow).Value
'rptProcessAvail
'srcProcessAvail
Range("rptProcessAvail") = _

Worksheets(sourceSheet).Range(Worksheets(mapSheet) .Range("srcProcessAvail").Value & sourceRow).Value
'rptCuProduced
'srcCuProduced
Range("rptCuProduced") = _

Worksheets(sourceSheet).Range(Worksheets(mapSheet) .Range("srcCuProduced").Value & sourceRow).Value
'rptRecovery
'srcRecovery
Range("rptRecovery") = _

Worksheets(sourceSheet).Range(Worksheets(mapSheet) .Range("srcRecovery").Value
& sourceRow).Value
'rptDLTI
'srcDLTI
Range("rptDLTI") = _

Worksheets(sourceSheet).Range(Worksheets(mapSheet) .Range("srcDLTI").Value &
sourceRow).Value
'rptOpNotes1
'srcOpNotes1
Range("rptOpNotes1") = _

Worksheets(sourceSheet).Range(Worksheets(mapSheet) .Range("srcOpNotes1").Value
& sourceRow).Value

Worksheets("Daily Report").PrintPreview
ExitDailyReporter:
If Err < 0 Then
Err.Clear
End If
On Error GoTo 0
End Sub



--
Carlee
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 363
Default User Date Picker rather than Input Box

You could use a form with a textbox.
Use something like:
Private Sub TextBox1_Enter()
' Textbox for date
call dtpDailyReport
End Sub

&

Private Sub CommandButton1_Click()
' Button to Unload userform and update sheet
if textbox1.value ="" then
msgbox "Please select a date"
textbox1.setfocus
else
if textbox1.value <"" then
' Enter you code to update sheet here.
unload me
end if
End Sub

"Carlee" wrote in message
...
Hi all

I have been using the following code to run a Daily Report. The input box
asks the user to enter a date, and the sheet uses the date entered to update
the sheet values.

Question: I want to use a date picker instead of an input box to enter a
date to update the values on the 'Daily Report' sheet. If there is no
information for the date, then display a message that says 'No data for date'

My date picker control is called dtpDailyReport. How can i accomplish this?

Public Sub PrepareDailyReport()
Const sourceSheet = "Daily Reading Master Log"
Const mapSheet = "ColumnsMap"
Dim userInput As Variant
Dim reportDate As Date
Dim searchRange As Range
Dim foundRange As Range
Dim searchAddress As String
Dim anyCell As Object
Dim sourceRow As Long

Application.ScreenUpdating = False
'we use this as a test to see if this can even be done
On Error Resume Next
searchAddress = "B1:" & Worksheets(sourceSheet).Range("B" &
Rows.Count).End(xlUp).Address
If Err < 0 Then
'couldn't find the sheet, don't do anything
'they have either renamed the other sheet, OR
'more likely, this sheet has been emailed
'all by itself to them.
Err.Clear
On Error GoTo 0
Exit Sub
End If
On Error GoTo 0 ' clear error trapping
' if it did not error out, then sheet 'sourceSheet' must be in
' the workbook with this sheet/code, so it should work.

userInput = InputBox("Enter Date for the Report - MM/DD/YYYY, Ex.Mar 1,
2007", "Report Date", "")
If userInput = "" Or Not (IsDate(userInput)) Then
Exit Sub
End If
reportDate = CDate(userInput)
Set searchRange = Worksheets(sourceSheet).Range(searchAddress)
'prepare the report
Worksheets(Me.Name).Activate
Range("rptDate") = reportDate
For Each anyCell In searchRange
If anyCell.Value = reportDate Then
Set foundRange = anyCell
Exit For ' quit looking
End If
Next
If foundRange Is Nothing Then
MsgBox "Date not matched. No Report Generated."
Exit Sub
End If
On Error GoTo ExitDailyReporter
'save the row number where our data is
sourceRow = foundRange.Row
'now copy the data
'rptPLSTreated
'srcPLSTreated
Range("rptPLSTreated") = _

Worksheets(sourceSheet).Range(Worksheets(mapSheet) .Range("srcPLSTreated").Value & sourceRow).Value
'rptPlantUtilization
'srcPlantUtilization
Range("rptPlantUtilization") = _

Worksheets(sourceSheet).Range(Worksheets(mapSheet) .Range("srcPlantUtilization").Value &
sourceRow).Value
'rptMechAvail
'srcMechAvail
Range("rptMechAvail") = _

Worksheets(sourceSheet).Range(Worksheets(mapSheet) .Range("srcMechAvail").Value & sourceRow).Value
'rptProcessAvail
'srcProcessAvail
Range("rptProcessAvail") = _

Worksheets(sourceSheet).Range(Worksheets(mapSheet) .Range("srcProcessAvail").Value & sourceRow).Value
'rptCuProduced
'srcCuProduced
Range("rptCuProduced") = _

Worksheets(sourceSheet).Range(Worksheets(mapSheet) .Range("srcCuProduced").Value & sourceRow).Value
'rptRecovery
'srcRecovery
Range("rptRecovery") = _

Worksheets(sourceSheet).Range(Worksheets(mapSheet) .Range("srcRecovery").Value
& sourceRow).Value
'rptDLTI
'srcDLTI
Range("rptDLTI") = _

Worksheets(sourceSheet).Range(Worksheets(mapSheet) .Range("srcDLTI").Value &
sourceRow).Value
'rptOpNotes1
'srcOpNotes1
Range("rptOpNotes1") = _

Worksheets(sourceSheet).Range(Worksheets(mapSheet) .Range("srcOpNotes1").Value
& sourceRow).Value

Worksheets("Daily Report").PrintPreview
ExitDailyReporter:
If Err < 0 Then
Err.Clear
End If
On Error GoTo 0
End Sub



--
Carlee


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
user input for date and time Rakesh[_3_] Excel Programming 0 September 11th 06 08:34 AM
Validate user input with specific date format YH Excel Programming 4 August 24th 06 02:38 PM
Verify user input box is a Month End Date mikeburg[_93_] Excel Programming 4 August 4th 06 05:42 PM
CF -- User input date range jujube Excel Programming 0 December 27th 05 08:45 PM
VBA: Look-Up Cell Date From User Input Box and return ALL matches Mcasteel[_38_] Excel Programming 1 November 11th 04 03:34 AM


All times are GMT +1. The time now is 07:48 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"