Time Formats & User Forms

[Denny57]

I am trying to find a solution to achieve the following using a series of User Forms to display groups of information

1. Input a time in "hh:mm" format into a User Form Text Box for uploading into a single base worksheet
2. Recall individual records from the same worksheet either using the time value (preferred as this value will be unique)

Information from the worksheet is then mapped to different fields in groups in another workshop. I intend to create a series of User Forms to display each of these groups . The "time" element is a critical part of these displays and so I need to identify the code which will store and recall time information in "hh:mm" format. The code must be able to be applied to recall the time in "hh:mm" format in all the User Forms.

I can work the individual User Form coding I just require the code to upload and recall time information in "hh:mm" format.

I need

1. code to convert a Text Box value to "hh:mm" format
2. To ensure the value is passed and stored in the worksheet in "hh:mm" format
3. Be able to search a worksheet Range for a unique time record using the same textbox ("hh:mm" formatted) and return all corresponding record values, including the time in "hh:mm" format, to the user form.

Previous attemps have either failed to find a match or when a record is recalled using a different matching value, the time value is either a numeric string or 00:01 (probably as a result of code to conver the cell value to hh:mm format)

I would appreciate if any responses could use textbox1 in the code, likewise if any other variables are need ed perhaps these can be highlighted and explained.

 

[dmt32]

I am trying to find a solution to achieve the following using a series of User Forms to display groups of information

couple of suggestions

Input a time in "hh:mm" format into a User Form Text Box for uploading into a single base worksheet

Create a function to manage user input to your TextBoxe(s)

In a standard module

Function IsValidTime(ByVal objTextBox As Object, Optional ByVal TimeFormat As String = "hh:mm") As Boolean
    'VBA TimeValue Remarks
    'You can enter valid times by using a 12-hour or 24-hour clock.
    'For example, "2:24PM" and "14:24" are both valid time entries.
    
    'If the entry contains valid date information, TimeValue only returns the time element.
    'if time includes invalid date information, an error is shown.
    
    'Optional TimeFormat can be specified by user otherwise Default(hh:mm) applied
    
    With objTextBox
        If Len(.Value) > 0 Then
            On Error Resume Next
            IsValidTime = IsDate(TimeValue(.Value))
            On Error GoTo 0
            If Not IsValidTime Then
                .Value = ""
                MsgBox "Please enter a valid time.", 48, "Invalid Time Entry"
            Else
                'apply format
                .Value = Format(TimeValue(.Value), TimeFormat)
            End If
        Else
            'allow blank exit
            IsValidTime = True
        End If
    End With
End Function

I have included remarks from VBA Helpfile for TimeValue function

To call - place following in UserForm Code Page

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Cancel = Not IsValidTime(Me.TextBox1)
End Sub

Change the name & apply same to each textbox as required

Not fully tested but hopefully, will do what you want.

I can work the individual User Form coding I just require the code to upload and recall time information in "hh:mm" format.

To return a time value in its format from a cell to your textbox, use the Text property of the Range

e.g. TextBox1.value = Cells(1,10).Text

This will return what you see in the cell & not the cells underlying value

I would appreciate any responses

Hopefully this will assist you but if need further help, posting your code would be helpful to the forum.

Dave

 

[Denny57]

dmt32

Thank you for your reply. Below is the code I am using which is based on similarly structured code I have used many times before. It is of syntax that I can understand.

The only sub-routine which is failing is the cmdViewRecord_Click() when I receive the message box "Race Time Not Found"

If you can see any changes which might assist this would be helpful, I shall be applying the code you provided shortly.

Meanwhile, please could you advise from yur reply where the following should be added and the source of "Cells(1,10).Text" as I am trying to understand why these numbers are significant. Many thanks

Current Code
Notes In Italics
Problem Code In Bold

Dim Currentrow As Long

Private Sub FullDetails_Click()
End Sub

Private Sub UserForm_Initialize()
txtBetCode = ""
txtMeetingVenue = ""
txtRaceTime = ""
txtNumberOfRunners = ""
txtFavouriteOddsF = ""
txtFavouriteOddsD = ""
cboEachWayOdds = ""
txtNumberOfPlaces = ""
txtSelectionNumber = ""
txtSelectionName = ""
txtBettingPlace1 = ""
txtBettingPrice1F = ""
txtBettingPrice1D = ""
txtSelectionGroup = ""
txtBettingPlace2 = ""
txtBettingPrice2F = ""
txtBettingPrice2D = ""
cboBetGroup = ""
boBetStake = ""
boBetType = ""
cboPriceOption = ""
txtStartingPrice = ""
cboRaceResult = ""
txtStartingPriceF = ""
txtStartingPriceD = ""
txtRule4Deduction = ""
cboDeadHeat = ""
txtNonRunnerBeforeBet = ""
txtNonRunnerAfterBet = ""
txtMeetingVenue.SetFocus

End Sub

Private Sub txtMeetingVenue_Change()
With Me.ActiveControl
.Value = StrConv(.Value, vbProperCase)
End With
End Sub

Private Sub txtSelectionName_Change()
With Me.ActiveControl
.Value = StrConv(.Value, vbProperCase)
End With
End Sub

Private Sub txtRaceTime_Afterupdate()
'Converts the keyed information into "hh:mm" format

Dim tString As String
With txtRaceTime
'Check if user put in a colon or not
If InStr(1, .Value, ":", vbTextCompare) = 0 Then
'If not, make string 4 digits and insert colon
tString = Format(.Value, "0000")
tString = Left(tString, 2) & ":" & Right(tString, 2)

txtRaceTime.Value = Format(TimeValue(tString), "hh:mm")
Else
'Otherwise, take value as given
.Value = Format(.Value, "hh:mm")
End If
End With
End Sub

Private Sub cmdAddRecord_Click()
Worksheets("Selections").Activate

lastrow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

ActiveSheet.Cells(lastrow + 1, 2).Value = txtMeetingVenue.Value
ActiveSheet.Cells(lastrow + 1, 3).Value = txtRaceTime.Value
ActiveSheet.Cells(lastrow + 1, 4).Value = txtNumberOfRunners.Value

End Sub

Private Sub cmdViewRecord_Click()

'Used to search for a unique Race Time in the database and return all corresponding values to the user form
'This Search function should be used ONLY when updating or viewing full records

Worksheets("Selections").Activate

Dim Res As Variant
Dim lastrow
Dim myFind As String

Res = Application.Match(txtRaceTime, Sheets("Selections").Range("C2:C70"), 0)

If IsError(Res) Then
MsgBox "Race Time Not Found", vbInformation, "Race Time Not Found"
Call UserForm_Initialize
txtRaceTime.SetFocus
Exit Sub
End If

lastrow = Sheets("Selections").Range("C" & Rows.Count).End(xlUp).Row
myFind = txtRaceTime
For Currentrow = 2 To lastrow
If Cells(Currentrow, 2).Text = myFind Then
txtBetCode.Value = ActiveSheet.Cells(Currentrow, 1).Value
txtMeetingVenue.Value = ActiveSheet.Cells(Currentrow, 2).Value
txtRaceTime.Value = ActiveSheet.Cells(Currentrow, 3).Value
txtNumberOfRunners.Value = ActiveSheet.Cells(Currentrow, 4).Value
txtFavouriteOddsF.Value = ActiveSheet.Cells(Currentrow, 5).Value
txtFavouriteOddsD.Value = ActiveSheet.Cells(Currentrow, 6).Value
cboEachWayOdds.Value = ActiveSheet.Cells(Currentrow, 7).Value
txtNumberOfPlaces.Value = ActiveSheet.Cells(Currentrow, 8).Value
txtSelectionNumber.Value = ActiveSheet.Cells(Currentrow, 9).Value
txtSelectionName.Value = ActiveSheet.Cells(Currentrow, 10).Value
txtBettingPlace1.Value = ActiveSheet.Cells(Currentrow, 11).Value
txtBettingPrice1F.Value = ActiveSheet.Cells(Currentrow, 12).Value
txtBettingPrice1D.Value = ActiveSheet.Cells(Currentrow, 13).Value
txtSelectionGroup.Value = ActiveSheet.Cells(Currentrow, 14).Value
txtBettingPlace2.Value = ActiveSheet.Cells(Currentrow, 15).Value
txtBettingPrice2F.Value = ActiveSheet.Cells(Currentrow, 16).Value
txtBettingPrice2D.Value = ActiveSheet.Cells(Currentrow, 17).Value
cboBetGroup.Value = ActiveSheet.Cells(Currentrow, 18).Value
cboBetStake.Value = ActiveSheet.Cells(Currentrow, 19).Value
cboBetType.Value = ActiveSheet.Cells(Currentrow, 20).Value
cboPriceOption.Value = ActiveSheet.Cells(Currentrow, 21).Value
txtPriceTakenSP.Value = ActiveSheet.Cells(Currentrow, 22).Value
cboSelectionResult.Value = ActiveSheet.Cells(Currentrow, 23).Value
txtPriceTakenSPF.Value = ActiveSheet.Cells(Currentrow, 24).Value
txtPriceTakenSPD.Value = ActiveSheet.Cells(Currentrow, 25).Value
txtRule4Deduction.Value = ActiveSheet.Cells(Currentrow, 26).Value
cboDeadHeat.Value = ActiveSheet.Cells(Currentrow, 27).Value
txtNonRunnersBeforeBet.Value = ActiveSheet.Cells(Currentrow, 28).Value
txtNonRunnersAfterBet.Value = ActiveSheet.Cells(Currentrow, 29).Value

Exit For
End If
Next Currentrow
txtRaceTime.SetFocus

End Sub

Private Sub cmdUpdateRecord_Click()
'Used to update existing records

Worksheets("Selections").Activate

answer = MsgBox("Update the Record?", vbYesNo + vbQuestion, "Update Record?")
If answer = vbNo Then
Call UserForm_Initialize
txtRaceTime.SetFocus
Else
'ActiveSheet.Cells(Currentrow, 1).Value = txtBetCode.Value
ActiveSheet.Cells(Currentrow, 2).Value = txtMeetingVenue.Value
ActiveSheet.Cells(Currentrow, 3).Value = txtRaceTime.Value
ActiveSheet.Cells(Currentrow, 4).Value = txtNumberOfRunners.Value
ActiveSheet.Cells(Currentrow, 5).Value = txtFavouriteOddsF.Value
'ActiveSheet.Cells(Currentrow, 6).Value = txtFavouriteOddsD.Value
ActiveSheet.Cells(Currentrow, 7).Value = cboEachWayOdds.Value
ActiveSheet.Cells(Currentrow, 8).Value = txtNumberOfPlaces.Value
ActiveSheet.Cells(Currentrow, 9).Value = txtSelectionNumber.Value
ActiveSheet.Cells(Currentrow, 10).Value = txtSelectionName.Value
ActiveSheet.Cells(Currentrow, 11).Value = txtBettingPlace1.Value
ActiveSheet.Cells(Currentrow, 12).Value = txtBettingPrice1F.Value
'ActiveSheet.Cells(Currentrow, 13).Value = txtBettingPrice1D.Value
ActiveSheet.Cells(Currentrow, 14).Value = txtSelectionGroup.Value
ActiveSheet.Cells(Currentrow, 15).Value = txtBettingPlace2.Value
ActiveSheet.Cells(Currentrow, 16).Value = txtBettingPrice2F.Value
'ActiveSheet.Cells(Currentrow, 17).Value = txtBettingPrice2D.Value
ActiveSheet.Cells(Currentrow, 18).Value = cboBetGroup.Value
ActiveSheet.Cells(Currentrow, 19).Value = cboBetStake.Value
ActiveSheet.Cells(Currentrow, 20).Value = cboBetType.Value
ActiveSheet.Cells(Currentrow, 21).Value = cboPriceOption.Value
ActiveSheet.Cells(Currentrow, 22).Value = txtPriceTakenSP.Value
ActiveSheet.Cells(Currentrow, 23).Value = cboSelectionResult.Value
'ActiveSheet.Cells(Currentrow, 24).Value = txtPriceTakenSPF.Value
'ActiveSheet.Cells(Currentrow, 25).Value = txtPriceTakenSPD.Value
ActiveSheet.Cells(Currentrow, 26).Value = txtRule4Deduction.Value
ActiveSheet.Cells(Currentrow, 27).Value = cboDeadHeat.Value
ActiveSheet.Cells(Currentrow, 28).Value = txtNonRunnersBeforeBet.Value
ActiveSheet.Cells(Currentrow, 29).Value = txtNonRunnersAfterBet.Value

MsgBox "Record has been updated", 0, "Record Updated"

Call UserForm_Initialize
txtRaceTime.SetFocus
End If
End Sub

Private Sub cmdClearForm_Click()
Call UserForm_Initialize
End Sub

Private Sub cmdCloseForm_Click()
Unload Me
End Sub

 

[dmt32]

dmt32

Thank you for your reply. Below is the code I am using which is based on similarly structured code I have used many times before. It is of syntax that I can understand.

Meanwhile, please could you advise from yur reply where the following should be added and the source of "Cells(1,10).Text" as I am trying to understand why these numbers are significant. Many thanks

You would change the Range property from Value to Text

example - change this line (and any other line where you need to display the cell format in your textboxes)

txtRaceTime.Value = ActiveSheet.Cells(Currentrow, 3).Value

to this

txtRaceTime.Value = ActiveSheet.Cells(Currentrow, 3).Text

Dave

 

[Denny57]

Regretably, it does not matter what changes I make to the code, I keep getting the same error and debug report.

I have now changed the conversion of Time input code to

Private Sub txtRaceTime_AfterUpdate()
If Len(txtRaceTime.Text) = 4 And InStr(txtRaceTime.Text, " ") = 0 Then
    txtRaceTime.Text = Left(txtRaceTime, 2) & ":" & Right(txtRaceTime, 2)
End If
End Sub

and the ws cells are formatted as text.

I have a different problem now but I am considering just using a 4 numeric value input for time.

 

[Denny57]

If I actujally had any hair I woulld be pulling out now.
For the first time I am actually sending and receiving information from a User Form in one ws to a different ws.

The code to send works fine and when calling back details the matching is working but there is something wrong in my code which will no longer import the record details. It was working fine when I was matching to a different record. but something is failing when I use the textbox that will contain a unique value.

I am using 4 numerics instead of hh:mm format

Hopefully you can help identify the error as I have tried many different changes to variables and code all to no avail.

Private Sub cmdViewRecord_Click()
'Used to search for a unique Race Time in the database and return all corresponding values to the user form
'This Search function should be used ONLY when updating  or viewing full records

Worksheets("Selections").Activate

Dim Res As Variant
Dim lastrow
Dim myFind As String

    Res = Application.Match(txtRaceTime, Sheets("Selections").Range("C2:C70"), 0)
    
    If IsError(Res) Then
        MsgBox "Race Time Not Found", vbInformation, "Race Time Not Found"
    Call UserForm_Initialize
    txtRaceTime.SetFocus
    Exit Sub
    End If
    
lastrow = Sheets("Selections").Range("C" & Rows.Count).End(xlUp).Row
myFind = txtRaceTime
For Currentrow = 2 To lastrow
If Cells(Currentrow, 2).Text = myFind Then
txtBetCode.Value = ActiveSheet.Cells(Currentrow, 1).Value
txtMeetingVenue.Value = ActiveSheet.Cells(Currentrow, 2).Value
txtRaceTime.Value = ActiveSheet.Cells(Currentrow, 3).Value

..........

 

[Denny57]

Thank you for your help with this..
By resetting the original code , using brief code to format the date information and using .Text instead of .Value when recalling the time details everything now works as I had hoped