populate table from comma separated data

supmktg · Sep 10, 2008

The record source for my report is a table that contains comma separated data in the field [Selections]. I need to filter my report by items that are in [Selections]. I have a multi-select listbox on my form to do that.

I am trying to populate the listbox by parsing the values in [Selections] and adding them to a table.

I've attached a sample file that should clarify what I'm trying to do:

The table "tblRowSource" needs to be updated onOpen of the from "frmSelectPrint" so it contains all of the items in the field [Selections] of "tblData".

Can anyone help me with a method to do this?

Thanks,
Sup

gemma-the-husky · Sep 10, 2008

you dont want to permanently store data in this way - you should extract it into separate fields, when it is first loaded, so it becomes a normalised table - this will make ongoing development far easier.

look at the function split

this will massage your csv data into an array of values, which you can then manage.

supmktg · Sep 10, 2008

I totally agree that would be the proper way to store the data. Unfortunately, I have no control over the data. I am building an external report generator that uses a "Professional" application's linked database as the source.

There are various groups (turns out to be about 135 of them) that students can be a member of. There is a field [Groups], that contains a comma separated list of the groups that a student belongs to. I am trying to include the functionality of being able to choose which groups to include or exclude from the report.

For me so far, this simple functionality has been a demonstration on how important data normalization can be going forward. Forget about what I'm trying to do in obtaining the list of all the groups. My report filter or query parameter, if they try to include too many groups, becomes way too long with all of the [Groups] Like "*Group1*" or [Groups] Like "*Group12*" or [Groups] Like "*Group125*" etc.

Thanks for the reply,
Sup

gemma-the-husky · Sep 10, 2008

then I would probably do this by writing a function that examines the text

rather than concatentating "like" expressions store a static array of the search terms
you want - eg Group1, Group2, Group4

then in a query, put the current group into a query column, but inside a function.

eg includeme(nz(grouptext,"")) (you need the nz in case the grouptext is blank), and in the driteria at the bottom put "true"

NOW you need a function in a module

function includeme(examinethis as string) as boolean

{in pseudocode}
for each item in your search criteria
if item IS in the string then
{code something like if instr(examinethis,item)>0 then ...}
end if
next item

end function

now INSIDE the function, you can in turn, examine each item you are looking for - eg Group1, group2, group3. In this case ignore the commas, and simply use the instr function.

You may want to return true for the function if any of the groups are a match, or you may return true only if all groups are a match - that depends on what you need. This will also affect how you write the control loop inside the function, to make it as efficient as you can - ie as soon as its known to be true or false, set the function result and exit

your query will now only select the rows for which your function determines that they should be included. It may not be blindingly fast, but I'm sure it will be acceptable.

hope this helps

CyberLynx · Sep 10, 2008

Code:

Private Sub Form_Open(Cancel As Integer)
[COLOR="DarkGreen"]   [B]'*** Reference to DAO Required ***[/B]

   'Required Variable declarations...[/COLOR]
   Dim rst As Recordset         [COLOR="DarkGreen"]'To hold records from 'tblData'[/COLOR]
   Dim ColorArray() As String   [COLOR="DarkGreen"]'To hold each color within the Selections Field[/COLOR]
   Dim i As Integer             [COLOR="DarkGreen"]'Place holder for enumerating through the ColorArray Array elements.[/COLOR]
   
   [COLOR="DarkGreen"]'Clear the tblRowSource table[/COLOR]
   CurrentDb.Execute "Delete * from tblRowSource", dbFailOnError
   
   [COLOR="DarkGreen"]'Fill the 'tblRowSource' Table with the delimited colors
   'found within each the 'Selections' field of each record
   'in the 'tblData' table. Also ensure no duplicates are
   'inserted.
   
   'Create a Recordset of the Selectons field contained
   'within the tblData Table[/COLOR]
   Set rst = CurrentDb.OpenRecordset("SELECT DISTINCT Selections FROM tblData", dbOpenDynaset)
   
  [COLOR="DarkGreen"] 'Enumerate through each record within the Recordset
   'so as to retrive the delimited data contained within
   'the 'Selectons' field or each record.[/COLOR]
   Do Until rst.EOF
       
      [COLOR="DarkGreen"]'Parse the colors found within the Selections field
      'into individual elements of an array (ColorArray())[/COLOR]
      ColorArray = Split(rst!Selections, ",")
         
      [COLOR="DarkGreen"]'Loop through the ColorArray and check each element
      '(color) to see if it already exists within the
      '"tblRowSource" Table.[/COLOR]
      For i = LBound(ColorArray) To UBound(ColorArray)
           
         [COLOR="DarkGreen"]'Remove spaces in the element string (if any).[/COLOR]
         ColorArray(i) = Replace(ColorArray(i), " ", "")
           
         [COLOR="DarkGreen"]'Does the item (color) already exist in the 'tblRowSource' Table?[/COLOR]
         If DCount("[Selections]", "[tblRowSource]", "[Selections]='" & ColorArray(i) & "'") = 0 Then
            [COLOR="DarkGreen"]'No...then insert item (color string) into table.[/COLOR]
              CurrentDb.Execute "INSERT INTO tblRowSource (Selections) VALUES ('" & ColorArray(i) & "');", dbFailOnError
         End If
      Next i
         
      [COLOR="DarkGreen"]'Clear the Array[/COLOR]
      ReDim ColorArray(0) As String
        
      [COLOR="DarkGreen"]'Go to next record[/COLOR]
      rst.MoveNext
   Loop
   
   [COLOR="DarkGreen"]'Close the Recordset[/COLOR]
   rst.Close
   
   [COLOR="DarkGreen"]'Free memory[/COLOR]
   Set rst = Nothing
End Sub

.

datAdrenaline · Sep 11, 2008

Hello Cyber ...

Not much time to fully evaluate your code, but ... this:

Code:

   [COLOR=darkgreen]'Populate the Recordset[/COLOR]
   rst.MoveLast: rst.MoveFirst
   
  [COLOR=darkgreen] 'If there are no records in the Recordset then don't bother.[/COLOR]
   If rst.RecordCount > 0 Then

Is not really needed .. you see, there is no need to populate the recordset since you will be looping through it anyway, plus since your Do..Loop uses the .EOF test (which will be True if the recordset is empty, then its not a real efficient to populate the recordset, in this case ... So, all you really need is the...

Code:

Do Until rst.EOF
...
Loop

CyberLynx · Sep 11, 2008

So true that is datAdrenaline.

Thank you for the correction.

.

raskew · Sep 11, 2008

Hi -

Based on your example, the following will delete/recreate tblTemp and fill it with unique, sorted colors from your comma-delimited tblData.

You can then use a query on tblTemp as the source for your list box. This will get slightly more complex (and probably more fulfilling) with the addition of various groups mentioned in your narrative. Look forward to seeing a working example.

Thanks to Paul Baldy for his assistance in sorting out the Create Unique Index issue.

Code:

Public Sub FillList(pTable As String)
'------------------------------------------------------------------
' Purpose:   Delete/create temp table and fills it with unique values
'            from comma delimited source strings
' Coded by:  raskew
' Calls:     Function StrCount
' Input:     Call FillList("tblTemp")
' Returns:   tblTemp filled with unique, sorted values from tblData
'------------------------------------------------------------------

Dim db      As database
Dim rs      As Recordset
Dim rs2     As Recordset
Dim strSQL  As String
Dim strHold As String
Dim i       As Integer

Dim n       As Integer

    On Error Resume Next
    'Delete/create tblTemp
    CurrentDb.Execute "DROP TABLE " & pTable & ";"
    strSQL = "CREATE TABLE " & pTable & " " _
           & "( Selection Text(20) Not Null );"
    CurrentDb.Execute strSQL
    CurrentDb.TableDefs.Refresh

    Set db = CurrentDb
    strSQL = "CREATE UNIQUE INDEX SelColor ON " & pTable & " ([Selection] ASC);"
    db.Execute strSQL
    Set rs = db.openrecordset("tblData")
    Set rs2 = db.openrecordset(pTable)
    Do While Not rs.EOF
       strHold = Trim(rs!Selections)
       i = StrCount(strHold, ",") + 1
       For n = 1 To i
         With rs2
         .AddNew
         If InStr(strHold, ",") > 0 Then
           !Selection = Trim(Left(strHold, InStr(strHold, ",") - 1))
         Else
           !Selection = Trim(strHold)
         End If
         .Update
         End With
         strHold = Mid(strHold, InStr(strHold, ",") + 1)
       Next n
       rs.MoveNext
    Loop

    rs.Close
    rs2.Close
    db.Close
End Sub

Function StrCount(ByVal TheStr As String, theItem As Variant) As Integer
'------------------------------------------------------------------
' Purpose:   Counts number of times item occurs in a string.
' Coded by:  raskew
' Arguments: TheStr: The string to be searched.
'            TheItem: The item to search for.
' Returns:   The number of occurences as an integer.
'
' Note: To test:   Type '? StrCount("The quick brown fox jumped over
'                  the lazy dog", "the") in the debug window.
'                  The function returns 2.
'------------------------------------------------------------------
Dim j         As Integer
Dim placehold As Integer
Dim strHold   As String
Dim itemHold  As Variant

    strHold = TheStr
    itemHold = theItem
    j = 0
    
    If InStr(1, strHold, itemHold) > 0 Then
       While InStr(1, strHold, itemHold) > 0
          placehold = InStr(1, strHold, itemHold)
          j = j + 1
          strHold = Mid(strHold, placehold + Len(itemHold))
       Wend
    End If
    StrCount = j
End Function

HTH - Bob

supmktg · Sep 11, 2008

Thank you all! I hope to post a working example soon.
Sup

populate table from comma separated data

supmktg

Registered User.

Attachments

gemma-the-husky

Super Moderator

supmktg

Registered User.

gemma-the-husky

Super Moderator

CyberLynx

Stuck On My Opinions

datAdrenaline

AWF VIP

CyberLynx

Stuck On My Opinions

raskew

AWF VIP

supmktg

Registered User.

Similar threads

Users who are viewing this thread