0

I need a query to execute whenever a Form closes (on Sub Form_Unload) that updates T2.id_from_t1 based on T1.Name = T2.Name. So it has to convert rows to column and match the result with the Name. Is it possible to do this with just one SQL query or VBA?

T1               T2
ID | Name        ID | Name | id_from_t1
1    Bob         1    Bob     1, 2
2    Bob         2    Joe     3, 4
3    Joe         3    Mark    5
4    Joe         4    Bill    6
5    Mark
6    Bill
Gordon Linoff
  • 1,242,037
  • 58
  • 646
  • 786
Perocat
  • 1,481
  • 7
  • 25
  • 48
  • Anything is possible! What did you try? Please do necessary [research](https://meta.stackoverflow.com/q/261592/1422451) and make an earnest attempt. StackOverflow helps with code implementation not yes/no, general forum questions. Also, refrain from comma separated values inside table columns as this obfuscates the relational model of databases. – Parfait Jul 01 '20 at 15:41
  • Why save this to table? It can be calculated when needed. http://allenbrowne.com/func-concat.html – June7 Jul 01 '20 at 17:25
  • Does this answer your question? [MS Access VBA: turn query results into a single string](https://stackoverflow.com/questions/32119921/ms-access-vba-turn-query-results-into-a-single-string) – June7 Jul 01 '20 at 17:28

1 Answers1

0

Here's how I solved my problem

Sub to iterate through the table to update (T2)

Public Sub tableToUpdate()
    Dim strSQL
    Dim DataB As Database
    Dim rs As Recordset
    Dim t2_id As Integer
    Dim values As String
    
    Set DataB = CurrentDb()
    
    Set rs = DataB.OpenRecordset("Select id from T2")
    Do While Not rs.EOF

        t2_id = rs("ID")
        Parks = GetListOptimal("Select T1.id as t1_id from T1 Where T1.id_t2 = " & t2_id, ", ", "")
        
        strSQL = "UPDATE T2 SET T2.t1_ids = '" & values & "' WHERE T2.id = " & t2_id

        DataB.Execute strSQL, dbFailOnError
        t2_id = 0
        values = ""
        
        rs.MoveNext
    Loop

    rs.Close
    DataB.Close

    Set rs = Nothing
    Set DataB = Nothing
End Sub

GetListOptimal is the function to generate the comma separated values

' Concatenate multiple values in a query. From:
' https://stackoverflow.com/questions/5174362/microsoft-access-condense-multiple-lines-in-a-table/5174843#5174843
'
' Note that using a StringBuilder class from here:
' https://codereview.stackexchange.com/questions/67596/a-lightning-fast-stringbuilder/154792#154792
' offers no code speed up

Public Function GetListOptimal( _
    SQL As String, _
    Optional fieldDelim As String = ", ", _
    Optional recordDelim As String = vbCrLf _
    ) As String

    Dim dbs As Database
    Dim rs As Recordset
    Dim records() As Variant
    Dim recordCount As Long

    ' return values
    Dim ret As String
    Dim recordString As String
    ret = ""
    recordString = ""

    ' index vars
    Dim recordN As Integer
    Dim fieldN As Integer
    Dim currentField As Variant

    ' array bounds vars
    Dim recordsLBField As Integer
    Dim recordsUBField As Integer
    Dim recordsLBRecord As Integer
    Dim recordsUBRecord As Integer

    ' get data from db
    Set dbs = CurrentDb
    Set rs = dbs.OpenRecordset(SQL)
    
   ' added MoveLast to get the real number of rows
    If rs.recordCount > 0 Then
        rs.MoveLast
        recordCount = rs.recordCount
        rs.MoveFirst
    End If

    ' Guard against no records returned
    If recordCount = 0 Then
        GetListOptimal = ""
        Exit Function
    End If

    records = rs.GetRows(recordCount)

    ' assign bounds of data
    recordsLBField = LBound(records, 1)    ' should always be 0, I think
    recordsUBField = UBound(records, 1)
    recordsLBRecord = LBound(records, 2)    ' should always be 0, I think
    recordsUBRecord = UBound(records, 2)

    ' FYI vba will loop thorugh every For loop at least once, even if
    ' both LBound and UBound are 0.  We already checked to ensure that
    ' there is at least one record, and that also ensures that
    ' there is at least one record.  I think...
    ' Can a SQL query return >0 records with 0 fields each?
    
    'Primo giro (per non aggiungere virgola)
    Dim first As Boolean
    first = True
    
    For recordN = recordsLBRecord To recordsUBRecord
        For fieldN = recordsLBField To recordsUBField
            ' Virgola prima del record solo se non siamo al primo e ultimo giro
            If first = False Then
                recordString = recordString & fieldDelim
            Else
                first = False
            End If

            ' records is indexed (field, record) for some reason
            currentField = records(fieldN, recordN)

            ' Guard against null-valued fields
            If Not IsNull(currentField) Then
                recordString = recordString & CStr(currentField)
            End If
        Next fieldN

        ' Only add recordDelim after at least one record
        If ret <> "" Then
            ret = ret & recordDelim
        End If
        ret = ret & recordString

        recordString = ""   ' Re-initialize to ensure no old data problems
    Next recordN

    ' adds final recordDelim at end output
    ' not sure when this might be a good idea
    ' TODO: Implement switch parameter to control
    ' this, rather than just disabling it
    ' If ret <> "" Then
    '    ret = ret & recordDelim
    ' End If

    ' Cleanup db objects
    Set dbs = Nothing
    Set rs = Nothing

    GetListOptimal = ret
    Exit Function
End Function

Sources used:

Perocat
  • 1,481
  • 7
  • 25
  • 48