User Date Picker rather than Input Box

C

Carlee

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
 
C

Corey

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

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VBA Coding Help for Beginner 0
userinterfaceonly=True fails with this code! 1
Remove Identical words 0
simple copy paste multiple range macro ARGUMENT ERROR 2
Change target sheet destination from A2 to M2. 13
Copy and paste range instead of entire row 1
Find the correct sheet then find a value on that sheet 8
Copy filtered data to sheet 2 1

Top