Textbox problem

  • Thread starter Thread starter Robert Couchman
  • Start date Start date
R

Robert Couchman

Good morning everyone,

can anyone please help?

i have records in my table that contain times, when i
select a date my macro finds all these times, then puts
them into textboxes (1-6)

what i need is a way of sorting the values, the way it
runs at the moment is where the first record that the date
matches, it will put the time into the first textbox, then
go through the rest of the records till it has found all
date matches. only problem is that the dates are in a
random order!

thank you,

Robert Couchman
([email protected])
 
Morning Robert,

As you only have 6 textboxes, a simple bubble sort should suffice. Here is
some code, but you will need to determine when to call it, whether you do it
whenever you change a textbox, or on a commandbutton or whatever.

Dim i As Long
Dim j As Long
Dim tmp As String
Dim fSorted As Boolean

For i = 1 To 5
For j = i + 1 To 6
If DateValue(Me.Controls("TextBox" & i).Text) > _
DateValue(Me.Controls("TextBox" & j).Text) Then
tmp = Me.Controls("TextBox" & i).Text
Me.Controls("TextBox" & i).Text = Me.Controls("TextBox" &
j).Text
Me.Controls("TextBox" & j).Text = tmp
End If
Next j
Next i

If your textboxes are named, hopefully they can easily be constructed as I
have done above, otherwise you will need to store them in an array and
extract from the array, something like

Me.Controls(aryTextBoxes(i)).Text

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Hello Bob,

thankyou for the help with the sorting, but i seem to have
a slight problem.

because not all the cells have times in, when they are
sorted, the blank spaces move to the top, so any data is
in the last few textboxes.

any ideas of how to solve this problem?

thank you,

Robert Couchman
([email protected])
 
Hello Robert,
any ideas of how to solve this problem?

Yeah, fix the code!

Dim i As Long
Dim j As Long
Dim tmp As String
Dim fSorted As Boolean

For i = 1 To 5
For j = i + 1 To 6
If Me.Controls("TextBox" & i).Text = "" Then
tmp = Me.Controls("TextBox" & i).Text
Me.Controls("TextBox" & i).Text = Me.Controls("TextBox" &
j).Text
Me.Controls("TextBox" & j).Text = tmp
ElseIf Me.Controls("TextBox" & j).Text = "" Then
'do nothing, but stop next bit executing
ElseIf DateValue(Me.Controls("TextBox" & i).Text) > _
DateValue(Me.Controls("TextBox" & j).Text) Then
tmp = Me.Controls("TextBox" & i).Text
Me.Controls("TextBox" & i).Text = Me.Controls("TextBox" &
j).Text
Me.Controls("TextBox" & j).Text = tmp
End If
Next j
Next i


Where shall we send the bill?

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Dim i As Long
Dim j As Long
Dim tmp As String
Dim fSorted As Boolean

For i = 1 To 5
For j = i + 1 To 6
If DateValue(Me.Controls("TextBox" & i).Text) > _
DateValue(Me.Controls("TextBox" & j).Text) _
or me.Controls("TextBox" & i).Text = '' Then
tmp = Me.Controls("TextBox" & i).Text
Me.Controls("TextBox" & i).Text = _
Me.Controls("TextBox" &j).Text
Me.Controls("TextBox" & j).Text = tmp
End If
Next j
Next i

Should cause blank values to move to the higher numbered boxes.
 
Cheers Bob,

i cant pretend i know what this code does at the moment,
but im sure i will figure it out soon.

as for the bill....

you could send it to my office, and i will file it with
the mail i dont often read :)

thanks Bob,

Robert Couchman
([email protected])
 
Desaster strikes!!!!

Bob, im afraid even though you have updated that piece of
code, it still seems to do the same thing!!

i will try .value instead of .text, but i cant see it
working!!

sorry!!

the cheque will bounce now! :)

Robert Couchman
([email protected])
 
Tell you what, I'll cut out the middle man and put it straight in the bin
myself, but you might be missing a good laugh<g>

Bob
 
I tested this and it works:

Private Sub CommandButton1_Click()
Dim i As Long
Dim j As Long
Dim tmp As String
Dim fSorted As Boolean
Dim sStr as String, sStr1 as String
Dim dti as Date, dtj as Date

For i = 1 To 5
For j = i + 1 To 6
sStr = Me.Controls("Textbox" & i)
sStr1 = Me.Controls("Textbox" & j)
If IsDate(sStr) Then
dti = CDate(sStr)
Else
dti = Date + 5000
End If
If IsDate(sStr1) Then
dtj = CDate(sStr1)
Else
dtj = Date + 5000
End If
If dti > dtj Then
Me.Controls("TextBox" & i).Text = _
Me.Controls("TextBox" & j).Text
Me.Controls("TextBox" & j).Text = sStr
End If
Next j
Next i

End Sub
 
Hello Tom,

thank you for the advice, but im afraid i have a problem.

i cannot use the function DateValue, as i am not using a
date to input into the textboxes, it is actually a number
(e.g. 12.00 for 12o'clock) so i end up with an error, and
if i remove the DateValue function then i end up with my
numbers in the last few textboxes.

can you please help sort out this problem?

Thank you,

Robert Couchman
([email protected])
 
Confusing Robert. You have used code with the datevalue and said it worked
except for the blanks problem.

are you actually putting in 12.00 instead of 12:00

Anyway, even using the "." this worked:

Private Sub CommandButton1_Click()
Dim i As Long
Dim j As Long
Dim tmp As String
Dim fSorted As Boolean
Dim sStr As String, sStr1 As String
Dim dti As Date, dtj As Date

' // generates random times in the textboxes - just
'// used for testing
For i = 1 To 6
If Rnd < 0.3 Then
Me.Controls("Textbox" & i).Text = ""
Else
Me.Controls("Textbox" & i).Text = _
Format(Rnd(), "h.mm")
End If
Next
'// remove the above

For i = 1 To 5
For j = i + 1 To 6
sStr = Me.Controls("Textbox" & i)
sStr1 = Me.Controls("Textbox" & j)
If IsDate(sStr) Then
dti = CDate(sStr)
Else
dti = Date + 5000
End If
If IsDate(sStr1) Then
dtj = CDate(sStr1)
Else
dtj = Date + 5000
End If
If dti > dtj Then
Me.Controls("TextBox" & i).Text = _
Me.Controls("TextBox" & j).Text
Me.Controls("TextBox" & j).Text = sStr
End If
Next j
Next i

End Sub
 
It worked in my tests, putting the blanks at the bottom.

Just tested it again, works fine.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Back
Top