asked on

Need an Access VBA code loop

Hello,

I have a table with multiple columns and each time the columns can change from say 8 - 10 fields. My ask is I concatenate all columns in one field called [Combine]. I have created update individual queries.
But what I'm trying to do is create vba code with some SQL loop update, that does the same thing as my queries, even when the fields changes from 8-10...
Please see attached Access DB; table [Members]; and the 7 queries I've created...
Thanks!
Update-db.accdb

crystal (strive4peace) - Microsoft MVP, Access

instead of this structure for your table, it would be better to set up a related table with a foreign key field linked to the primary key of the main table. Then each answer would be in a different record and you wouldn't have to worry about how many fields there are -- and then here is code to loop and combine you can call to concatenate values in related records

'~~~~~~~~~~~~~~~~ testLoopAndCombine
Sub testLoopAndCombine()
'test LoopAndCombine
   Dim sTablename As String _
      , sIDFieldname As String _
      , sTextFieldname As String _
      , nValueID As Long _
      , sFieldSortBy As String
   
   sTablename = "MyTablename"
   sIDFieldname = "MyNumericForeignKeyFieldname" 'if FK is not a n umber, you will need to add delimiters to LoopAndCombine where it is referenced
   sTextFieldname = "Description of Fieldname"
   nValueID = 138 'some number you know is in the table
   sFieldSortBy = "FieldnameToSortBy"
   
   MsgBox LoopAndCombine(sTablename, sIDFieldname, sTextFieldname, nValueID, , , , sFieldSortBy)

End Sub

'~~~~~~~~~~~~~~~~ LoopAndCombine
Function LoopAndCombine( _
   psTablename As String _
   , psIDFieldname As String _
   , psTextFieldname As String _
   , pnValueID As Long _
   , Optional psWhere As String = "" _
   , Optional psDeli As String = ", " _
   , Optional psNoValue As String = "" _
   , Optional psOrderBy As String = "" _
   ) As String
's4p
'loop through recordset and combine values to one string
   
   'NEEDS REFERENCE
   'a Microsoft DAO Library
   ' -- OR --
   ' Microsoft Office #.0 Access Database Engine Object Library
   
   'PARAMETERS
   'psTablename --> tablename to get list from
   'psIDFieldname --> fieldname to link on (ie: "BookID")
   'psTextFieldname --> fieldname to combine (ie: "PageNumber")
   'pnValueID --> actual value of ID for this iteration ( ie: [BookID])
   'psWhere, Optional  --> more criteria (ie: "Year(PubDate) = 2006")
   'psDeli, Optional  --> delimiter other than comma (ie: ";", Chr(13) & Chr(10))
   'psNoValue, Optional  --> value to use if no data (ie: "No Pages")
   'psOrderBy, Optional  --> fieldlist to Order By
   
   'Set up error handler
   On Error GoTo Proc_Err
      
   'dimension variables
   Dim rs As DAO.Recordset _
      , vAllValues As Variant _
      , sSQL As String
    
   vAllValues = Null
  
   sSQL = "SELECT [" & psTextFieldname & "] " _
       & " FROM [" & psTablename & "]" _
       & " WHERE [" & psIDFieldname _
       & "] = " & pnValueID _
       & IIf(Len(psWhere) > 0, " AND " & psWhere, "") _
       & IIf(Len(psOrderBy) > 0, " ORDER BY " & psOrderBy, "") _
       & ";"
       
   'open the recordset
   Set rs = CurrentDb.OpenRecordset(sSQL, dbOpenSnapshot)
      
   'loop through the recordset until the end
   With rs
      Do While Not rs.EOF
         If Not IsNull(.Fields(psTextFieldname)) Then
   
            '~~~~~~~~~~~~~~~~~~~~~~~~~ CHOOSE ONE
   
            '---- if field value is numeric
            vAllValues = (vAllValues + psDeli) _
             & Trim(.Fields(psTextFieldname))
   
            '---- uncomment if you want quotes around data
            'vAllValues = (vAllValues + psDeli) _
             & " '" & Trim(.Fields(psTextFieldname)) & "'"
            '~~~~~~~~~~~~~~~~~~~~~~~~~
          End If
         .MoveNext
      Loop
   End With 'rs
      
   If Len(vAllValues) = 0 Then
      vAllValues = psNoValue
   End If
 
   
Proc_Exit:
   'close the recordset
   rs.Close
   'release the recordset variable
   Set rs = Nothing
    
   LoopAndCombine = Trim(Nz(vAllValues, ""))
   Exit Function
   
'if there is an error, the following code will execute
Proc_Err:
   MsgBox Err.Description, , _
     "ERROR " & Err.Number _
      & "   LoopAndCombine"
 
   Resume Proc_Exit
   Resume
End Function

Open in new window

Craig Yellick

You can combine all fields in a single query. Having to deal with nulls and adding a delimiter makes the statement a bit ugly but it's a copy+paste job in the SQL text mode window of the query designer.

update Members set Combine = iif(S01 is null, "", S01 & "; ") & iif(S02 is null, "", S02 & "; ") ...

Craig Yellick

If you want to do it in a code loop, it'd look like this.

  Dim rs As Recordset
  Set rs = CurrentDb.OpenRecordset("select * from Members")
  While Not rs.EOF
    Dim i As Integer
    Dim fld As String
    Dim s As String
    s = ""
    For i = 1 To 12
      fld = "S" & Right("0" & i, 2)
      If Not IsNull(rs(fld)) Then s = s & rs(fld) & "; "
    Next
    rs.Edit
    rs!Combine = s
    rs.Update
    rs.MoveNext
  Wend

Open in new window

tyruss8

ASKER

Hi Crystal, for the suggestion and code I will look into it, but I'm afraid I may not understand the full code as my experience in vba is intermediate at best.
thanks

tyruss8

ASKER

Hi CraigYellick,

I've copied and pasted your suggested vba code and got an error "item not found in this collection"?

Thanks

ASKER CERTIFIED SOLUTION

Craig Yellick

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

tyruss8

ASKER

Thanks CraigYellick worked like charm appreciate it!