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 |
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 |
All times are GMT +1. The time now is 06:48 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com