Add sortable column headings to listbox 3

[GelC]

Hi all,
I'm struggling with the sortable feature applies to my listbox.
I have a search form to filter unbound text boxes then populated the result into a listbox:
unbound text boxes: txtName,txtCity, txtState
unbound listbox: lboCustInfo
The code for searching work nicely.

Dim strSQL As String, strOrder As String, strWhere As String

strSQL = "SELECT qryInfo.CustID, qryInfo.Name, qryInfo.City, qryInfo.State " & _
"FROM qryInfo"

strWhere = "WHERE"

strOrder = "ORDER BY qryInfo.CustID;"

If Not IsNull(Me.txtName) Then 
    strWhere = strWhere & " (qryInfo.Name) Like '*" & Me.txtName & "*'  AND" '
End If

If Not IsNull(Me.txtCity) Then
strWhere = strWhere & " (qryInfo.City) Like '*" & Me.txtCity & "*'  AND"
End If

If Not IsNull(Me.txtState) Then
strWhere = strWhere & " (qryInfo.State) Like '*" & Me.txtState & "*'  AND"
End If

strWhere = Mid(strWhere, 1, Len(strWhere) - 5)

Me.lboInfo.RowSource = strSQL & " " & strWhere & "" & strOrder

I have the following sorting function, but it's not working as I wanted. When I click on column headers to sort, I lost my search result and it sorted the full list of records instead.
Any help please?

Const mcRowSourceSortCol1 = mcRowSourceBasis & " Order By 1;"
Const mcRowSourceSortCol1Desc = mcRowSourceBasis & " Order By 1 Desc;"
Const mcRowSourceSortCol2 = mcRowSourceBasis & " Order By 2;"
Const mcRowSourceSortCol2Desc = mcRowSourceBasis & " Order By 2 Desc;"
Const mcRowSourceSortCol3 = mcRowSourceBasis & " Order By 3;"
Const mcRowSourceSortCol3Desc = mcRowSourceBasis & " Order By 3 Desc;"
Const mcRowSourceSortCol4 = mcRowSourceBasis & " Order By 4;"
Const mcRowSourceSortCol4Desc = mcRowSourceBasis & " Order By 4 Desc;"

Private Sub cmdSortCol1_Click()
If lboInfo.RowSource = mcRowSourceSortCol1 Then
    lboInfo.RowSource = mcRowSourceSortCol1Desc
Else
    lboInfo.RowSource = mcRowSourceSortCol1
End If
End Sub

Private Sub cmdSortCol2_Click()
If lboInfo.RowSource = mcRowSourceSortCol2 Then
    lboInfo.RowSource = mcRowSourceSortCol2Desc
Else
    lboInfo.RowSource = mcRowSourceSortCol2
End If
End Sub

Private Sub cmdSortCol3_Click()
If lboInfo.RowSource = mcRowSourceSortCol3 Then
    lboInfo.RowSource = mcRowSourceSortCol3Desc
Else
    lboInfo.RowSource = mcRowSourceSortCol3
End If
End Sub

Private Sub cmdSortCol4_Click()
If lboIssues.RowSource = mcRowSourceSortCol4 Then
    lboInfo.RowSource = mcRowSourceSortCol4Desc
Else
    lboInfo.RowSource = mcRowSourceSortCol4
End If
End Sub

 

[JBinQLD]

G'day,

function MakeSQL(strOrder as string) as string

Dim strSQL As String, strOrder As String, strWhere As String

strSQL = "SELECT qryInfo.CustID, qryInfo.Name, qryInfo.City, qryInfo.State " & _
"FROM qryInfo"

strWhere = "WHERE"

strOrder = "ORDER BY qryInfo.CustID;"

If Not IsNull(Me.txtName) Then 
    strWhere = strWhere & " (qryInfo.Name) Like '*" & Me.txtName & "*'  AND" '
End If

If Not IsNull(Me.txtCity) Then
strWhere = strWhere & " (qryInfo.City) Like '*" & Me.txtCity & "*'  AND"
End If

If Not IsNull(Me.txtState) Then
strWhere = strWhere & " (qryInfo.State) Like '*" & Me.txtState & "*'  AND"
End If

strWhere = Mid(strWhere, 1, Len(strWhere) - 5)
MakeSQL= strSQL & " " & strWhere & "" & strOrder
end function

now on open of your form:

Me.lboInfo.RowSource = MakeSQL(" ORDER BY qryInfo.CustID;")

and then on your captions:

Private Sub cmdSortCol1_Click()
If lboInfo.RowSource = MakeSQL(" Order By 1;") Then
    lboInfo.RowSource = MakeSQL(" Order By 1 DESC;") 
Else
    lboInfo.RowSource = MakeSQL(" Order By 1;")
End If
End Sub

The routines on the caption could call a function with the Order By number as a parameter, and perhaps the control name so you could use it throughout your app....

Hope this helps,

JB

 

[GelC]

Thanks JB!
I'll try it tomorrow and let you know the outcome.

 

[TheAceMan1]

How are ya GelC . . .

[blue]mcRowSourceBasis[/blue] has to equal [blue]lboInfo.RowSource[/blue] without the [blue]ORDER BY[/blue] clause so you can append the newly selected.

What is the source of [blue]mcRowSourceBasis[/blue]? ... particularly since you have variable criteria. Saving to a global variable after criteria is accomplished is in order!

See Ya! . . . . . .

Be sure to see thread181-473997 [blue]Worthy Reading![/blue]
Also faq181-2886 [blue]Worthy Reading![/blue]

 

[GelC]

JB,
With your suggestion, the cmdSearch is not working any more. Then I got this error:
"Syntax error (missing operator) in query expression "Me.lboInfo.Rowsource Order By 4 Desc"

TheAceMan1,
My mcRowSourceBasis = "SELECT qryInfo.CustID, qryInfo.Name, qryInfo.City, qryInfo.State FROM qryInfo"
I know it's not right but how can I replace this string after criteria.

 

[JBinQLD]

G'day Gelc,

The logic behind your search button now needs to be the same as the form on open event:

Me.lboInfo.RowSource = MakeSQL(" ORDER BY qryInfo.CustID;")

both will then call our funky new function that always takes into account the content of the search controls cos that's what the new function is based upon

JB

 

[GelC]

JB,
I tried and got this error still

"Syntax error (missing operator) in query expression "Me.lboInfo.Rowsource Order By 4 Desc"

Any thought?

Do I still need to define the Const?

 

[JBinQLD]

No, you dont need the const at all. Purely the code I have posted, which is all your own work but presented in a different way.

We've simply changed your old search button code into a function that adds the relevant "Order By" part once it has built your SQL exactly as before. This is what was missing with your original version. You were building the SQL in two ways, one to sort, and one to take into consideration the search parameters. This new function does both things, because we pass it a variable telling it what we want the sort to be.

However, I have noticed a bug in my code where I've forgotton to delete a line! We pass the function a variable called "strOrder" which tells it what we want to order by, but then on line 6 we hard code it's value. Oops. My bad, please remove this line:

strOrder = "ORDER BY qryInfo.CustID;"

Also, I notice a missing space in the final line. It should be:

MakeSQL= strSQL & " " & strWhere & " " & strOrder

Note the space in the final set of " ". Also, for testing purposes please add a line:

Msgbox(strSQL & " " & strWhere & "" & strOrder)

which should of course show you what the rowsource of your listbox is about to be set to.

This will hopefully give you a clue as to what's going on.


JB

 

[GelC]

Thanks for your patience, please bear with me for a little while.
Here is the problem: my form can't be opened but when I removed the code for OnOpen event, it opened and .....do nothing.
So, it means the function MakeSQL can't be called.
When I put the msgbox under search button for testing, it gave me a blank box. Any thought?

 

[JBinQLD]

No worries Gel,

Have you tried compiling the code to ensure it's all entered correctly? I'm about to go bed but I've got crap all to do tomorrow apart from a small database deployment so I'll test it for real late morning. So far I've been coding blind hence the silly typo errors.

Will post any corrections in about 10 hours...

JB

 

[PHV]

the function MakeSQL uses controls values and thus shouldn't be called in the Open event but the Load event.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[JBinQLD]

PHV has most likely hit the nail on the head there. Another silly mistake from me posting without testing, and so obvious if i'd tested it first. My apologies Gel, my thanks PHV.

On the plus side, you've hopefully got a solution 9.5 hours before I would have noticed that silly error!

I'm going to go to bed and dream of a thousand hail maries or something for not considering that with your code! Happy dayz fellas,

JB

 

[GelC]

Thanks PHV for pointed out the error.
The form can be opened now. However, my listbox is empty, none records was loaded base on the MakeSQL function.

 

[JBinQLD]

I had left one more tiny error in. The variable strOrder is declared twice in the function:

function MakeSQL(strOrder as string) as string

Dim strSQL As String, strOrder As String, strWhere As String

so I declare strOrder as a passed variable and then go on to Dim it. So, please change to:

function MakeSQL(strOrder as string) as string

Dim strSQL As String, strWhere As String

This immediately caused a compile error for me so it was easy to spot.

Once you've done that you'll find it works perfectly. I copied and pasted directly from this post so definately no other errors!

Sorry for the delay, have a great weekend.

JB

PS. For improved user interface it may be worth moving your search button logic to the after update events of txtName, txtCity, txtCity, etc. That way the user can type and as soon as they hit enter the listbox immediately updates without them needing to take the mouse and click a button, whatever works for you, just an idea!

 

[TheAceMan1]

How are ya GelC . . .

I've been moitoring this thread and now wish to present my solution. Disable or store in a text file or remove all prior code dealing with this problem ([blue]to prevent interaction[/blue]). Then in form design view:
[ol][li]In the [blue]RowSource[/blue] property of the listbox, copy/paste the following:

[blue]SELECT CustID, Name, City, State FROM qryInfo ORDER BY 1;[/blue]

This sets the [blue]Default RowSource[/blue] of the listbox and alleviates any problems opening the form, which always opens with the select statement above![/li]
[li]The [blue]Name[/blue] property of the unbound textboxes need to match the field names, so drop the preappended [blue]txt[/blue] for each.[/li]
[li]In the [blue]Tag[/blue] property of the unbound textboxes, enter a question mark [blue]?[/blue] ([red]no quotations please![/red]).[/li]
[li]In the code module of the form, copy/paste the following routine:

[blue]Public Sub lbxSort(Col As Integer)
   Dim SQL As String, Cri As String, ctl As Control, prp As Property, OBy As String
   
   Set prp = Me!lboInfo.Properties("RowSource")
   SQL = "SELECT CustID, Name, City, State " & _
         "FROM qryInfo"
   
   For Each ctl In Me.Controls
      If ctl.Tag = "?" Then
         If Trim(ctl & "") <> "" Then
            If Cri <> "" Then
               Cri = Cri & "AND [" & ctl.Name & "] Like '*" & Me(ctl.Name) & "*' "
            Else
               Cri = "WHERE [" & ctl.Name & "] Like '*" & Me(ctl.Name) & "*' "
            End If
         End If
      End If
   Next
   
   OBy = "ORDER BY " & CStr(Col)
   
   If InStrRev(prp, OBy) > 0 Then
      If InStrRev(prp, OBy & " DESC") = 0 Then
         OBy = OBy & " DESC"
      End If
   End If
   
   prp = SQL & " " & Cri & OBy & ";"
   
   Set prp = Nothing
   
End Sub[/blue]

[/li]
[li]In the [blue]After Update[/blue] event of each of the unbound textboxes, copy/paste the following:

[blue]Call lbxSort(1)[/blue]

This makes the listbox update as you parse thru the unbound textboxes.[/li]
[li]Finally ... in the [blue]On Click[/blue] event of your sorting buttons, copy/paste the following (you replace [purple]ColumnNumber[/purple] approriately):

[blue]Call lbxSort([purple][B][I]ColumnNumber[/I][/B][/purple])[/blue]

Note: the routine automatically handles toggling the sort![/li]
[li][blue]Perform Your Testing![/blue][/li][/ol]
[blue]Your Thoughts? . . .[/blue]

See Ya! . . . . . .

Be sure to see thread181-473997 [blue]Worthy Reading![/blue]
Also faq181-2886 [blue]Worthy Reading![/blue]

 

[GelC]

Thanks guys for helping out.
So sorry cuz I was so busy over the weekend with my holidays list (smile
I tried both of your suggestions/solutions, work perfectly. I must give each of you five stars.
I can't imaging life is that simple with help and sharing.
Thank you very much

 

[MajP]

I find it a whole lot easier to work with the recordset of the listbox. Then you can use the DAO sort and filter properties. Here is a quick way to sort a listbox from ascending/descending from a combo box regardless of the filtered recordset.

Private Sub cmd1_Click()
  
  Dim rs As DAO.Recordset
  Set rs = Me.List1.Recordset.Clone
  
  If cmd1.Tag = "OrderID" Then
    cmd1.Tag = "OrderID DESC"
  Else
    cmd1.Tag = "OrderID"
  End If
  rs.Sort = cmd1.Tag
  Set rs = rs.OpenRecordset
  Set Me.List1.Recordset = rs
  
End Sub

Private Sub cmd2_Click()
  Dim rs As DAO.Recordset
  Set rs = Me.List1.Recordset.Clone
  
  If cmd2.Tag = "OrderDate" Then
    cmd2.Tag = "OrderDate DESC"
  Else
    cmd2.Tag = "OrderDate"
  End If
  rs.Sort = cmd2.Tag
  Set rs = rs.OpenRecordset
  Set Me.List1.Recordset = rs
End Sub