Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 77
  • Last Modified:

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
0
tyruss8
Asked:
tyruss8
  • 3
  • 3
1 Solution
 
crystal (strive4peace) - Microsoft MVP, AccessRemote Training and ProgrammingCommented:
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

0
 
Craig YellickDatabase ArchitectCommented:
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 & "; ")  ...
0
 
Craig YellickDatabase ArchitectCommented:
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

0
Get your Disaster Recovery as a Service basics

Disaster Recovery as a Service is one go-to solution that revolutionizes DR planning. Implementing DRaaS could be an efficient process, easily accessible to non-DR experts. Learn about monitoring, testing, executing failovers and failbacks to ensure a "healthy" DR environment.

 
tyruss8Author Commented:
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
0
 
tyruss8Author Commented:
Hi CraigYellick,

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

Thanks
0
 
Craig YellickDatabase ArchitectCommented:
You probably don't have 12 columns of data.  I wrote the code anticipating that you'd have 10+ columns and would  have to adjust for the zero-padded numbers.

Change the line "For i = 1 To 12" to whatever upper limit is present in your table.
0
 
tyruss8Author Commented:
Thanks CraigYellick worked like charm appreciate it!
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

  • 3
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now