Thursday, March 31, 2011

Getting a Proper Title Sort Order in Microsoft Access

In our publications database I have my student workers enter the titles as they appear, which means that they often have an initial article. Unlike MARC Access does not have a built-in way to tell it to ignore the first four, or whatever, spaces before sorting, so all the titles beginning with “The” are grouped together and all the titles beginning with “An” are grouped together, as so on. I wanted the sort order to ignore any initial articles, since that is the way most users except a list of titles to be constructed. I had thought of adding an “non-indexing spaces” field and using that to control the sort order. This idea was rejected because it meant another data element that the student workers would have to enter, and they would have to think about it not just transcribe what was on the item. Instead, I decided to deal with the initial articles after the fact.

What I did was create a function which strips the initial articles from the titles as the list is being created and the output from the function is used to sort the list even though the full title is displayed. I put this function in a module I call BasicFunctionsRDM, which is where I park any function I might use in other databases, if I need it I just import the entire module into another database. You can place this code in any module you like.

Public Function Article(strTitle As String)
     'Debug.Print "Before: " & strTitle

     'First make sure there are no double spaces after the initial article
     'replace any double spaces with a single space.

     strTitle = Replace(strTitle, Chr(32) & Chr(32), Chr(32))

     'Strip off any initial double quotes

     If Mid(strTitle, 1, 1) Like Chr(34) Then
          strTitle = Mid(strTitle, 2)
     End If

     'Strip the initial article from the title by using the mid-string function.
     'Always include, and count, the space after the article, otherwise you will
     'end up stripping the first two characters from a title beginning "Always".

     If Mid(strTitle, 1, 4) Like "The " Then
          strTitle = Mid(strTitle, 5)
     ElseIf Mid(strTitle, 1, 2) Like "A " Then
          strTitle = Mid(strTitle, 3)
     ElseIf Mid(strTitle, 1, 3) Like "An " Then
          strTitle = Mid(strTitle, 4)
     'Strip off any initial spaces.
     ElseIf Mid(strTitle, 1, 1) Like Chr(32) Then
          strTitle = Mid(strTitle, 2)
     'Strip off any single quotes at the beginning of the title.
     ElseIf Mid(strTitle, 1, 1) Like Chr(33) Then
          strTitle = Mid(strTitle, 2)
     'Strip off any exclamation points at the beginning of the title.
     ElseIf Mid(strTitle, 1, 1) Like Chr(39) Then
          strTitle = Mid(strTitle, 2)
     ElseIf Mid(strTitle, 1, 3) Like "El " Then
          strTitle = Mid(strTitle, 4)
     'Use a single character wildcard to catch both "Le " and "La ".
     ElseIf Mid(strTitle, 1, 3) Like "L? " Then
          strTitle = Mid(strTitle, 4)
     ElseIf Mid(strTitle, 1, 3) Like "De " Then
          strTitle = Mid(strTitle, 4)
     ElseIf Mid(strTitle, 1, 3) Like "Di " Then
          strTitle = Mid(strTitle, 4)
     ElseIf Mid(strTitle, 1, 3) Like "Il " Then
          strTitle = Mid(strTitle, 4)
     ElseIf Mid(strTitle, 1, 3) Like "Un " Then
          strTitle = Mid(strTitle, 4)
     ElseIf Mid(strTitle, 1, 2) Like "l'" Then
          strTitle = Mid(strTitle, 3)
     'Use a single character wildcard to catch both "Uno " and "Una ".
     ElseIf Mid(strTitle, 1, 4) Like "Un? " Then
          strTitle = Mid(strTitle, 5)
     'Use a single character wildcard to catch "Les ", "Las ", and "Los ".
     ElseIf Mid(strTitle, 1, 4) Like "L?s " Then
          strTitle = Mid(strTitle, 5)
     ElseIf Mid(strTitle, 1, 4) Like "Gli " Then
          strTitle = Mid(strTitle, 5)
     'Use a single character wildcard to catch "Der ", "Dem ", "Den ", and "Des ".
     ElseIf Mid(strTitle, 1, 4) Like "De? " Then
          strTitle = Mid(strTitle, 5)
     ElseIf Mid(strTitle, 1, 6) Like "Einen " Then
          strTitle = Mid(strTitle, 7)
     ElseIf Mid(strTitle, 1, 5) Like "Eine " Then
          strTitle = Mid(strTitle, 6)
     ElseIf Mid(strTitle, 1, 4) Like "Ein " Then
          strTitle = Mid(strTitle, 5)
     ElseIf Mid(strTitle, 1, 4) Like "Die " Then
          strTitle = Mid(strTitle, 5)
     ElseIf Mid(strTitle, 1, 4) Like "Das " Then
          strTitle = Mid(strTitle, 5)
     End If

     'Strip off any double quotes left at the beginning of the title.
     If Mid(strTitle, 1, 1) Like Chr(34) Then
          Article = Mid(strTitle, 2)
     Else:
          Article = strTitle
     End If

     'Debug.Print "After: " & Article

End Function

It’s not perfect. I’m sure I’ve missed some articles in other languages and probably some for the languages I did try to cover, but it is very easy to add another article and this pretty well covers the ones most common in our database.

To use this function simply include it the “Order By” clause of your SQL query. So if you have a text box, txtKeyword, and a search button, cmdSearch, the code in the “On Click” event would look something like this:

Private Sub cmdKeyword_Click()
On Error GoTo Err_cmdKeyword_Click

     Dim strKey As String       'Variable for the keyword.
     Dim strSQL As String      'Variable for the SQL query to populate the results list.

     strKey = Nz(Me!txtKeyword, "")
     strKey = Authority(strKey)
     'Debug.Print strKey
     'Format the keyword with wildcards and single quotes.
     strKey = "'*" & strKey & "*'"
     'Debug.Print "strKey = " & strKey

     'This SQL query pulls the pamphlet ID, title, and date for any pamphlet with
     'the keyword anywhere in the title. It then sorts it by title, ignoring initial articles.

     strSQL = "SELECT tblPams.PamID, tblPams.Title, tblPams.Date FROM tblPams "
     strSQL = strSQL & "WHERE tblPams.Title LIKE " & strKey & " "
     strSQL = strSQL & " ORDER BY Article(tblPams.Title), tblPams.Date;"
     'Debug.Print strSQL

     'Display the search results in a list box.
     Me.lstPamList.RowSource = strSQL
     Forms!frmStartPage.Refresh

     'Display the search query in a text box, txtString, on the form.
     Me!txtString = "Results for Search: Keyword Anywhere LIKE " & strKey & ""

     'Clear the keyword text box.
     Me!txtKeyword = Null

     Exit_cmdKeyword_Click:
          Exit Sub

Err_cmdKeyword_Click:
     MsgBox Err.Description
     Resume Exit_cmdKeyword_Click

End Sub

No comments:

Post a Comment