Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
user input for date and time | Excel Programming | |||
Validate user input with specific date format | Excel Programming | |||
Verify user input box is a Month End Date | Excel Programming | |||
CF -- User input date range | Excel Programming | |||
VBA: Look-Up Cell Date From User Input Box and return ALL matches | Excel Programming |