[AccessD] merging records

    You are welcome John!  I have since optimized the subroutine still further. Taking into account the point raised by you, iteration through fields is now implemented based upon their number position. This eliminates the repeated check against InStr() function for excluding initial set of fields (not directly representing survey response). Instead, the loop starts at first survey field. In the sample case, position of this field, represented by constant PosOfFirstSurveyField is 5. You can substitute this figure by an appropriate value as required.

    Two versions of the optimized subroutine have been made out, one uses append query for final insertion, while the other depends upon recorset's AddNew method as suggested by Gustav.

    The first routine, named P_PopulateResultTableByAppQry() is placed below. The other one, named P_PopulateResultTableByRecordset() shall be sent by subsequent post, so as to avoid crossing the max size prescribed by the moderators.

Best wishes,
A.D.Tejpal
------------

Sample subroutine - for merging survey results
T_data is source table. Compacted results (ignoring
blanks) are appended to T_Result.
'====================================
Sub P_PopulateResultTableByAppQry()
    ' This subroutine merges the survey
    ' results (ignoring blanks) for each person in source
    ' table T_Data and appends the compacted outcome
    ' into destination table T_Result. Structure of T_Result
    ' is identical to that of T_Data
    ' T_Dummy is a single field single record table.
    
    Dim Qst As String, Txt As String
    Dim Fnm As String, Qst2 As String
    Dim Cnt As Long
    
    Dim rst1 As DAO.Recordset
    Dim rst2 As DAO.Recordset
    Dim tdf As TableDef
    Dim db As DAO.Database
    
    Const SourceTable As String = "T_Data"
    Const DestnTable As String = "T_Result"
    Const DummyTable As String = "T_Dummy"
    Const PosOfFirstSurveyField As Long = 5
    
    Set db = DBEngine(0)(0)
    
    ' Clear destination table
    db.Execute "DELETE FROM " & _
                    DestnTable & ";", dbFailOnError
    
    Qst = "SELECT FirstName, LastName, " & _
            "Address FROM " & SourceTable & _
            " GROUP BY FirstName, " & _
            "LastName, Address;"
    Set rst1 = db.OpenRecordset(Qst)
    
    Set tdf = db.TableDefs(SourceTable)
    
    Do Until rst1.EOF
        ' Build first part of SQL for appending Person
        ' and address particulars
        Qst = "INSERT INTO " & DestnTable & _
                " SELECT '" & _
                rst1.Fields("FirstName") & "' AS " & _
                "FirstName, '" & rst1.Fields("LastName") & _
                "' AS LastName, '" & rst1.Fields("Address") & _
                "' AS Address,"
        
        ' Build balance portion of SQL for appending
        ' survey results (ignoring blanks), field-wise
        For Cnt = (PosOfFirstSurveyField - 1) _
                                To (tdf.Fields.Count - 1)
            Fnm = tdf.Fields(Cnt).Name
            Qst2 = "SELECT " & Fnm & _
                        " FROM " & SourceTable & _
                        " WHERE FirstName = '" & _
                        rst1.Fields("FirstName") & _
                        "' AND LastName = '" & _
                        rst1.Fields("LastName") & _
                        "' AND Address = '" & _
                        rst1.Fields("Address") & _
                        "' AND Len(" & Fnm & ") > 0;"
            Set rst2 = db.OpenRecordset(Qst2)
            
            ' This If/End If block is meant to prevent
            ' error (no current record) if rst2 is empty
            If rst2.RecordCount > 0 Then
                Qst = Qst & " '" & rst2.Fields(0) & _
                        "' AS " & Fnm & ","
            End If
        Next
        
        ' Remove trailing comma
        Qst = Left(Qst, Len(Qst) - 1)
        Qst = Qst & " FROM " & DummyTable & ";"
        
        ' Append to destination table
        db.Execute Qst, dbFailOnError
        
        rst1.MoveNext
    Loop
    
    rst1.Close
    rst2.Close
    Set rst1 = Nothing
    Set rst2 = Nothing
    Set tdf = Nothing
    Set db = Nothing
End Sub
'====================================

  ----- Original Message ----- 
  From: jwcolby 
  To: 'Access Developers discussion and problem solving' 
  Sent: Friday, November 16, 2007 00:57
  Subject: Re: [AccessD] merging records


  A.D.

  I will get around to this, just not sure when.  Running this through Access
  / VBA is probably a non starter since not only are there a lot of fields
  (>600), but also a lot of records (>50 million).  Thus if this is ever to
  actually work it will need to be done in VB.Net.  My experience so far is
  that VB.Net speeds things up by a factor of 10 or more.

  Even then I would suggest something like pulling the field names that will
  be actually used out and placing them (or maybe their numeric field position
  in the record object) in a collection.  That way the code that iterates the
  fields becomes a simple "for each in colValidFld" construct instead of a
  constant comparison to see if they are in the string of non-valid fields.

  If you place the valid field names in the collection, then the For Each loop
  would "just have" the field names to build up the SQL statement.
  Additionally I think you can use the field names to index into the field
  collection to extract the values:

  rst.fields(strFldName).value

  Believe me, with 600 fields and 50 million records, it needs all the
  efficiency it can get.

  And BTW thanks for the code.

  John W. Colby
  Colby Consulting
  www.ColbyConsulting.com