Return to Question

deleted 30 characters in body

Source Link

edited Jun 5, 2014 at 16:00

Jamal

35.2k
13
134
238

Many thanks for your help.

Add/force vb syntax highlighting

Source Link

edited Jun 5, 2014 at 15:17

rolfl

98.1k
17
219
419

Sub condenseOutputDocs()

'If gcfHandleErrors Then On Error GoTo Err_General

Dim strCOMP_NAME As String
Dim strDfltParam As String
Dim strParamsExpOld As String
Dim strParamsExpNew As String
Dim intParamPos As Integer
Dim strREF1 As String
Dim intNB1 As Integer
Dim strCOMP_NAME1 As String
Dim strPAR1 As String
Dim strREF2 As String
Dim strREFnew As String
Dim intNB2 As Integer
Dim strCOMP_NAME2 As String
Dim strPAR2 As String
Dim strCOMMENT1 As String
Dim strCOMMENT2 As String
Dim strCOMMENTnew As String
Dim lngCmntFndPos As Long
Dim intSlashCount As Integer
Dim intCommaCount As Integer
Dim strCmntPrefix As String

Dim td As TableDef
Dim fldDef As Field
Dim strFldNameList As String
Dim strFldNameArray() As String
Dim intFldCount As Integer
Dim intFldIndex As Integer
Dim strThisFldName As String
Dim str1stRecContents As String
Dim str2ndRecContents As String

Dim lngID1 As Long
Dim lngID2 As Long

Dim lngCurrDocTblRecordCount As Long


'------------------------------------------------------------------------------------
' Condenses output documents by combining records where all fields except NB, REF and COMMENT match
'
' Adds NBs from combined fields together to give total number of components
'
' Also takes all REF, NB and COMMENTS and concatenates them into a string separated by the "~" character
' for later processing / recombining - temporarily stored in the COMMENT field.
'
' Also replaces blank fields temporarily with the "¿" character as a special flag for later processing
'
' So for example the following 2 records (note that fields REF, NB, COMP_NAME and COMMENT are present in all tables, but
' there may be any number of fields inbetween COMP_NAME and COMMENT with different names, but COMP_NAME and all of these
' fields must match for a record to be combined):
'
' REF       NB  COMP_NAME       PARAMS          COMMENT
' A         2   RAFTER          L=2000 P=25     BLAH
' B         5   RAFTER          L=2000 P=25     FEH
' C         3   RAFTER          L=2000 P=25     BLAH
' D         2   RAFTER          L=2000 P=25     [BLANK]
' [BLANK]   4   RAFTER          L=2000 P=25     [BLANK]
' [BLANK]   6   RAFTER          L=2000 P=25     FOO
'
' then become as an intermediate step:
'
' REF   NB  COMP_NAME       PARAMS          COMMENT
' A     22  RAFTER          L=2000 P=25     A~2~BLAH~B~5~FEH~C~3~BLAH~D~2~¿~¿~4~¿~¿~6~FOO~
' Lines show separation of records:        |        |       |        |     |     |       |
' (note REF is currently unchanged and will be the REF from the first found record which is matched to others)
' (Also blank values are replaced with ¿ for later processing)
'
' And eventually in a later module will be processed further and become:
'
' REF               NB  COMP_NAME       PARAMS          COMMENT
' A:2,B:5,C:3,D:2   16  RAFTER          L=2000 P=25     [A:2/C:3 - BLAH] [B:5 - FEH] [NoRef:6 - FOO]
'
'-------------------------------------------------------------------------------------

Set db = CurrentDb

Set RS_tmpTblDocsOutList = db.OpenRecordset("tmpTblDocsOutList", dbOpenDynaset) 'tmpTblDocsOutList contains a list of all tables to be processed in this way
'tmbTblDocstOutlist is comstructed earlier in another sub.

Do While Not RS_tmpTblDocsOutList.EOF ' loop through output docs

    strDocOut = RS_tmpTblDocsOutList![OUT_DOCUMENT] & ""
    
    Debug.Print "-------------------------------------------------------------------"
    Debug.Print "strDocOut = " & strDocOut
    
    ' Open a recordset for the document table
    Set RS_CurrDocTbl = db.OpenRecordset(strDocOut, dbOpenDynaset)
            
    Set td = db.TableDefs(strDocOut)
    
    RS_CurrDocTbl.MoveLast
    lngCurrDocTblRecordCount = RS_CurrDocTbl.RecordCount ' count the records - suspect there may be a better way, but I need to populate the recordset anyway.
    RS_CurrDocTbl.MoveFirst
    
    Debug.Print "curr doc tbl record count = " & lngCurrDocTblRecordCount
    
    lngID1 = 0 '1st record ID

    Do While lngID1 < (lngCurrDocTblRecordCount) ' loop through records (first)

        RS_CurrDocTbl.MoveFirst
        RS_CurrDocTbl.Move (lngID1) 'move to 1st rec currently being worked on - Suspect there is a better way of doing this.
             
        ' initialise / clear variables
        strFldNameList = ""
        str1stRecContents = ""
        str2ndRecContents = ""
        
        intFldCount = td.Fields.Count ' get total number of fields
                
            ' Feed the names of the arbitrary fields in this document that contain parameters, into a comma-delimited string
        For Each fldDef In td.Fields
            strFldNameList = strFldNameList & fldDef.Name & ","  ' append this field name to the string, then the delimiting comma - suspect that this is unnecessary?
        Next

        strFldNameList = Left(strFldNameList, Len(strFldNameList) - 1) 'delete final comma from delimited string

        ReDim strFldNameArray(0 To intFldCount - 1)

        ' Create an array from the string and store it into strFldNameArray
        strFldNameArray = Split(strFldNameList, ",")

        ' For the first comparison record, get the contents of the COMP_NAME field and the arbitrary fields containing
        ' parameters and feed them into a concatenated string sequence:

        For intFldIndex = 2 To intFldCount - 2  ' for each of the fields except the 1st (REF), 2nd (NB) and final (COMMENT) fields (note this structure will always be the same)
            strThisFldName = strFldNameArray(intFldIndex) ' get this field name
            str1stRecContents = str1stRecContents & RS_CurrDocTbl(strThisFldName) & ""  ' append the field's contents to the string
        Next
            
            
        strREF1 = RS_CurrDocTbl![REF] & ""
        
        If strREF1 = "" Then 'if ref is blank
            strREF1 = "¿" ' replace with special flag character for later processing
        End If

        intNB1 = RS_CurrDocTbl![NB] ' each record will ALWAYS have a NB - will be an int, usually no more than ~60

        strCOMMENT1 = RS_CurrDocTbl![COMMENT] & ""
        
        If strCOMMENT1 & "" = "" Then
            strCOMMENT1 = "¿" ' if comment is blank then replace with special flag character
        End If

        If Right(strCOMMENT1, 1) <> "~" Then ' if comment does not already contain some comment (from a previous run through) then create new concatenated string
            strCOMMENT1 = strREF1 & "~" & intNB1 & "~" & strCOMMENT1 & "~" ' e.g. "A~3~Cable groove~"
        End If

        Debug.Print "strCOMMENT1 = " & strCOMMENT1

        RS_CurrDocTbl.Edit
        RS_CurrDocTbl![COMMENT] = strCOMMENT1 ' save new comment string into table
        RS_CurrDocTbl.Update

        lngID2 = lngID1 + 1 ' lngID1 is current record, set lngID2 (record to be compared to current record) to initially be the next record in the list

        Do While Not RS_CurrDocTbl.EOF 'loop through records (2nd)

            RS_CurrDocTbl.MoveFirst ' move to first record in table
            RS_CurrDocTbl.Move (lngID2) ' then move [lngID2] spaces forward to seek to correct record for comparisons - suspect there is a better way
                
            str2ndRecContents = "" ' initialise variable / clear from previous run

            If Not RS_CurrDocTbl.EOF Then
                    
                For intFldIndex = 2 To intFldCount - 2  ' for each of the fields except the 1st (REF), 2nd (NB) and final (COMMENT) fields
                    strThisFldName = strFldNameArray(intFldIndex) ' get this field name
                    str2ndRecContents = str2ndRecContents & RS_CurrDocTbl(strThisFldName) & ""  ' append its contents to the string
                Next
            
                strREF2 = RS_CurrDocTbl![REF] & ""
                
                If strREF2 = "" Then ' if ref is blank
                    strREF2 = "¿" ' replace with key character for later processing
                End If

                intNB2 = RS_CurrDocTbl![NB]

                strCOMMENT2 = RS_CurrDocTbl![COMMENT] & ""
                            
                If strCOMMENT2 = "" Then ' if comment is blank
                    strCOMMENT2 = "¿" ' replace with key character for later processing
                End If
                    
                If Right(strCOMMENT2, 1) <> "~" Then
                    strCOMMENT2 = strREF2 & "~" & intNB2 & "~" & strCOMMENT2 & "~" ' e.g. "A~3~Cable groove~"
                End If
                    
                RS_CurrDocTbl.Edit
                RS_CurrDocTbl![COMMENT] = strCOMMENT2
                RS_CurrDocTbl.Update
                    
                Debug.Print "strComment2 = " & strCOMMENT2
                    
                If str1stRecContents = str2ndRecContents Then ' if a match is found

                    RS_CurrDocTbl.Delete ' delete current (2nd) record
                    
                    lngCurrDocTblRecordCount = lngCurrDocTblRecordCount - 1 ' decrement number of records
                    
                    RS_CurrDocTbl.MoveFirst
                    RS_CurrDocTbl.Move (lngID1) ' move to 1st record
                                                
                    RS_CurrDocTbl.Edit
                    RS_CurrDocTbl![NB] = RS_CurrDocTbl![NB] + intNB2 ' add numbers to get total count
                    RS_CurrDocTbl![COMMENT] = RS_CurrDocTbl![COMMENT] & strCOMMENT2
                    RS_CurrDocTbl.Update
                    
                    ' this leaves ref unchanged as this will be processed in a later module by extracting info from the (now combined and concatenated) comment field
                        
                    Debug.Print "Match found - Records combined"
                    
                    Debug.Print "lngCurrDocTblRecordCount = " & lngCurrDocTblRecordCount
            
                Else

                    Debug.Print "No match found"
                    lngID2 = lngID2 + 1 ' only increase ID of 2nd record being compared if it has not just been deleted

                End If ' end record contents comparison

            End If ' end EOF testing
            
        Loop ' end looping through (2nd) records
                
        lngID1 = lngID1 + 1 ' increment 1st record ID
    
        Debug.Print "******* lngID1 = " & lngID1

    Loop ' end looping through (1st) records
        
    RS_tmpTblDocsOutList.MoveNext ' move to next table
    
Loop ' end looping through documents/tables

RS_CurrDocTbl.Close ' close current table
RS_tmpTblDocsOutList.Close ' close list of tables

condenseComments ' call sub which condenses comments
                
Exit Sub
        
        
' General Error Handler:
Exit_Err_General:
Exit Sub

Err_General:
MsgBox "Oops! There's been an error!  Error " & Err.Number & ": " & Err.Description

close_all_open_tables ' what it says

Resume Exit_Err_General

End Sub

Sub condenseOutputDocs()

'If gcfHandleErrors Then On Error GoTo Err_General

Dim strCOMP_NAME As String
Dim strDfltParam As String
Dim strParamsExpOld As String
Dim strParamsExpNew As String
Dim intParamPos As Integer
Dim strREF1 As String
Dim intNB1 As Integer
Dim strCOMP_NAME1 As String
Dim strPAR1 As String
Dim strREF2 As String
Dim strREFnew As String
Dim intNB2 As Integer
Dim strCOMP_NAME2 As String
Dim strPAR2 As String
Dim strCOMMENT1 As String
Dim strCOMMENT2 As String
Dim strCOMMENTnew As String
Dim lngCmntFndPos As Long
Dim intSlashCount As Integer
Dim intCommaCount As Integer
Dim strCmntPrefix As String

Dim td As TableDef
Dim fldDef As Field
Dim strFldNameList As String
Dim strFldNameArray() As String
Dim intFldCount As Integer
Dim intFldIndex As Integer
Dim strThisFldName As String
Dim str1stRecContents As String
Dim str2ndRecContents As String

Dim lngID1 As Long
Dim lngID2 As Long

Dim lngCurrDocTblRecordCount As Long


'------------------------------------------------------------------------------------
' Condenses output documents by combining records where all fields except NB, REF and COMMENT match
'
' Adds NBs from combined fields together to give total number of components
'
' Also takes all REF, NB and COMMENTS and concatenates them into a string separated by the "~" character
' for later processing / recombining - temporarily stored in the COMMENT field.
'
' Also replaces blank fields temporarily with the "¿" character as a special flag for later processing
'
' So for example the following 2 records (note that fields REF, NB, COMP_NAME and COMMENT are present in all tables, but
' there may be any number of fields inbetween COMP_NAME and COMMENT with different names, but COMP_NAME and all of these
' fields must match for a record to be combined):
'
' REF       NB  COMP_NAME       PARAMS          COMMENT
' A         2   RAFTER          L=2000 P=25     BLAH
' B         5   RAFTER          L=2000 P=25     FEH
' C         3   RAFTER          L=2000 P=25     BLAH
' D         2   RAFTER          L=2000 P=25     [BLANK]
' [BLANK]   4   RAFTER          L=2000 P=25     [BLANK]
' [BLANK]   6   RAFTER          L=2000 P=25     FOO
'
' then become as an intermediate step:
'
' REF   NB  COMP_NAME       PARAMS          COMMENT
' A     22  RAFTER          L=2000 P=25     A~2~BLAH~B~5~FEH~C~3~BLAH~D~2~¿~¿~4~¿~¿~6~FOO~
' Lines show separation of records:        |        |       |        |     |     |       |
' (note REF is currently unchanged and will be the REF from the first found record which is matched to others)
' (Also blank values are replaced with ¿ for later processing)
'
' And eventually in a later module will be processed further and become:
'
' REF               NB  COMP_NAME       PARAMS          COMMENT
' A:2,B:5,C:3,D:2   16  RAFTER          L=2000 P=25     [A:2/C:3 - BLAH] [B:5 - FEH] [NoRef:6 - FOO]
'
'-------------------------------------------------------------------------------------

Set db = CurrentDb

Set RS_tmpTblDocsOutList = db.OpenRecordset("tmpTblDocsOutList", dbOpenDynaset) 'tmpTblDocsOutList contains a list of all tables to be processed in this way
'tmbTblDocstOutlist is comstructed earlier in another sub.

Do While Not RS_tmpTblDocsOutList.EOF ' loop through output docs

    strDocOut = RS_tmpTblDocsOutList![OUT_DOCUMENT] & ""
    
    Debug.Print "-------------------------------------------------------------------"
    Debug.Print "strDocOut = " & strDocOut
    
    ' Open a recordset for the document table
    Set RS_CurrDocTbl = db.OpenRecordset(strDocOut, dbOpenDynaset)
            
    Set td = db.TableDefs(strDocOut)
    
    RS_CurrDocTbl.MoveLast
    lngCurrDocTblRecordCount = RS_CurrDocTbl.RecordCount ' count the records - suspect there may be a better way, but I need to populate the recordset anyway.
    RS_CurrDocTbl.MoveFirst
    
    Debug.Print "curr doc tbl record count = " & lngCurrDocTblRecordCount
    
    lngID1 = 0 '1st record ID

    Do While lngID1 < (lngCurrDocTblRecordCount) ' loop through records (first)

        RS_CurrDocTbl.MoveFirst
        RS_CurrDocTbl.Move (lngID1) 'move to 1st rec currently being worked on - Suspect there is a better way of doing this.
             
        ' initialise / clear variables
        strFldNameList = ""
        str1stRecContents = ""
        str2ndRecContents = ""
        
        intFldCount = td.Fields.Count ' get total number of fields
                
            ' Feed the names of the arbitrary fields in this document that contain parameters, into a comma-delimited string
        For Each fldDef In td.Fields
            strFldNameList = strFldNameList & fldDef.Name & ","  ' append this field name to the string, then the delimiting comma - suspect that this is unnecessary?
        Next

        strFldNameList = Left(strFldNameList, Len(strFldNameList) - 1) 'delete final comma from delimited string

        ReDim strFldNameArray(0 To intFldCount - 1)

        ' Create an array from the string and store it into strFldNameArray
        strFldNameArray = Split(strFldNameList, ",")

        ' For the first comparison record, get the contents of the COMP_NAME field and the arbitrary fields containing
        ' parameters and feed them into a concatenated string sequence:

        For intFldIndex = 2 To intFldCount - 2  ' for each of the fields except the 1st (REF), 2nd (NB) and final (COMMENT) fields (note this structure will always be the same)
            strThisFldName = strFldNameArray(intFldIndex) ' get this field name
            str1stRecContents = str1stRecContents & RS_CurrDocTbl(strThisFldName) & ""  ' append the field's contents to the string
        Next
            
            
        strREF1 = RS_CurrDocTbl![REF] & ""
        
        If strREF1 = "" Then 'if ref is blank
            strREF1 = "¿" ' replace with special flag character for later processing
        End If

        intNB1 = RS_CurrDocTbl![NB] ' each record will ALWAYS have a NB - will be an int, usually no more than ~60

        strCOMMENT1 = RS_CurrDocTbl![COMMENT] & ""
        
        If strCOMMENT1 & "" = "" Then
            strCOMMENT1 = "¿" ' if comment is blank then replace with special flag character
        End If

        If Right(strCOMMENT1, 1) <> "~" Then ' if comment does not already contain some comment (from a previous run through) then create new concatenated string
            strCOMMENT1 = strREF1 & "~" & intNB1 & "~" & strCOMMENT1 & "~" ' e.g. "A~3~Cable groove~"
        End If

        Debug.Print "strCOMMENT1 = " & strCOMMENT1

        RS_CurrDocTbl.Edit
        RS_CurrDocTbl![COMMENT] = strCOMMENT1 ' save new comment string into table
        RS_CurrDocTbl.Update

        lngID2 = lngID1 + 1 ' lngID1 is current record, set lngID2 (record to be compared to current record) to initially be the next record in the list

        Do While Not RS_CurrDocTbl.EOF 'loop through records (2nd)

            RS_CurrDocTbl.MoveFirst ' move to first record in table
            RS_CurrDocTbl.Move (lngID2) ' then move [lngID2] spaces forward to seek to correct record for comparisons - suspect there is a better way
                
            str2ndRecContents = "" ' initialise variable / clear from previous run

            If Not RS_CurrDocTbl.EOF Then
                    
                For intFldIndex = 2 To intFldCount - 2  ' for each of the fields except the 1st (REF), 2nd (NB) and final (COMMENT) fields
                    strThisFldName = strFldNameArray(intFldIndex) ' get this field name
                    str2ndRecContents = str2ndRecContents & RS_CurrDocTbl(strThisFldName) & ""  ' append its contents to the string
                Next
            
                strREF2 = RS_CurrDocTbl![REF] & ""
                
                If strREF2 = "" Then ' if ref is blank
                    strREF2 = "¿" ' replace with key character for later processing
                End If

                intNB2 = RS_CurrDocTbl![NB]

                strCOMMENT2 = RS_CurrDocTbl![COMMENT] & ""
                            
                If strCOMMENT2 = "" Then ' if comment is blank
                    strCOMMENT2 = "¿" ' replace with key character for later processing
                End If
                    
                If Right(strCOMMENT2, 1) <> "~" Then
                    strCOMMENT2 = strREF2 & "~" & intNB2 & "~" & strCOMMENT2 & "~" ' e.g. "A~3~Cable groove~"
                End If
                    
                RS_CurrDocTbl.Edit
                RS_CurrDocTbl![COMMENT] = strCOMMENT2
                RS_CurrDocTbl.Update
                    
                Debug.Print "strComment2 = " & strCOMMENT2
                    
                If str1stRecContents = str2ndRecContents Then ' if a match is found

                    RS_CurrDocTbl.Delete ' delete current (2nd) record
                    
                    lngCurrDocTblRecordCount = lngCurrDocTblRecordCount - 1 ' decrement number of records
                    
                    RS_CurrDocTbl.MoveFirst
                    RS_CurrDocTbl.Move (lngID1) ' move to 1st record
                                                
                    RS_CurrDocTbl.Edit
                    RS_CurrDocTbl![NB] = RS_CurrDocTbl![NB] + intNB2 ' add numbers to get total count
                    RS_CurrDocTbl![COMMENT] = RS_CurrDocTbl![COMMENT] & strCOMMENT2
                    RS_CurrDocTbl.Update
                    
                    ' this leaves ref unchanged as this will be processed in a later module by extracting info from the (now combined and concatenated) comment field
                        
                    Debug.Print "Match found - Records combined"
                    
                    Debug.Print "lngCurrDocTblRecordCount = " & lngCurrDocTblRecordCount
            
                Else

                    Debug.Print "No match found"
                    lngID2 = lngID2 + 1 ' only increase ID of 2nd record being compared if it has not just been deleted

                End If ' end record contents comparison

            End If ' end EOF testing
            
        Loop ' end looping through (2nd) records
                
        lngID1 = lngID1 + 1 ' increment 1st record ID
    
        Debug.Print "******* lngID1 = " & lngID1

    Loop ' end looping through (1st) records
        
    RS_tmpTblDocsOutList.MoveNext ' move to next table
    
Loop ' end looping through documents/tables

RS_CurrDocTbl.Close ' close current table
RS_tmpTblDocsOutList.Close ' close list of tables

condenseComments ' call sub which condenses comments
                
Exit Sub
        
        
' General Error Handler:
Exit_Err_General:
Exit Sub

Err_General:
MsgBox "Oops! There's been an error!  Error " & Err.Number & ": " & Err.Description

close_all_open_tables ' what it says

Resume Exit_Err_General

End Sub

Sub condenseOutputDocs()

'If gcfHandleErrors Then On Error GoTo Err_General

Dim strCOMP_NAME As String
Dim strDfltParam As String
Dim strParamsExpOld As String
Dim strParamsExpNew As String
Dim intParamPos As Integer
Dim strREF1 As String
Dim intNB1 As Integer
Dim strCOMP_NAME1 As String
Dim strPAR1 As String
Dim strREF2 As String
Dim strREFnew As String
Dim intNB2 As Integer
Dim strCOMP_NAME2 As String
Dim strPAR2 As String
Dim strCOMMENT1 As String
Dim strCOMMENT2 As String
Dim strCOMMENTnew As String
Dim lngCmntFndPos As Long
Dim intSlashCount As Integer
Dim intCommaCount As Integer
Dim strCmntPrefix As String

Dim td As TableDef
Dim fldDef As Field
Dim strFldNameList As String
Dim strFldNameArray() As String
Dim intFldCount As Integer
Dim intFldIndex As Integer
Dim strThisFldName As String
Dim str1stRecContents As String
Dim str2ndRecContents As String

Dim lngID1 As Long
Dim lngID2 As Long

Dim lngCurrDocTblRecordCount As Long


'------------------------------------------------------------------------------------
' Condenses output documents by combining records where all fields except NB, REF and COMMENT match
'
' Adds NBs from combined fields together to give total number of components
'
' Also takes all REF, NB and COMMENTS and concatenates them into a string separated by the "~" character
' for later processing / recombining - temporarily stored in the COMMENT field.
'
' Also replaces blank fields temporarily with the "¿" character as a special flag for later processing
'
' So for example the following 2 records (note that fields REF, NB, COMP_NAME and COMMENT are present in all tables, but
' there may be any number of fields inbetween COMP_NAME and COMMENT with different names, but COMP_NAME and all of these
' fields must match for a record to be combined):
'
' REF       NB  COMP_NAME       PARAMS          COMMENT
' A         2   RAFTER          L=2000 P=25     BLAH
' B         5   RAFTER          L=2000 P=25     FEH
' C         3   RAFTER          L=2000 P=25     BLAH
' D         2   RAFTER          L=2000 P=25     [BLANK]
' [BLANK]   4   RAFTER          L=2000 P=25     [BLANK]
' [BLANK]   6   RAFTER          L=2000 P=25     FOO
'
' then become as an intermediate step:
'
' REF   NB  COMP_NAME       PARAMS          COMMENT
' A     22  RAFTER          L=2000 P=25     A~2~BLAH~B~5~FEH~C~3~BLAH~D~2~¿~¿~4~¿~¿~6~FOO~
' Lines show separation of records:        |        |       |        |     |     |       |
' (note REF is currently unchanged and will be the REF from the first found record which is matched to others)
' (Also blank values are replaced with ¿ for later processing)
'
' And eventually in a later module will be processed further and become:
'
' REF               NB  COMP_NAME       PARAMS          COMMENT
' A:2,B:5,C:3,D:2   16  RAFTER          L=2000 P=25     [A:2/C:3 - BLAH] [B:5 - FEH] [NoRef:6 - FOO]
'
'-------------------------------------------------------------------------------------

Set db = CurrentDb

Set RS_tmpTblDocsOutList = db.OpenRecordset("tmpTblDocsOutList", dbOpenDynaset) 'tmpTblDocsOutList contains a list of all tables to be processed in this way
'tmbTblDocstOutlist is comstructed earlier in another sub.

Do While Not RS_tmpTblDocsOutList.EOF ' loop through output docs

    strDocOut = RS_tmpTblDocsOutList![OUT_DOCUMENT] & ""
    
    Debug.Print "-------------------------------------------------------------------"
    Debug.Print "strDocOut = " & strDocOut
    
    ' Open a recordset for the document table
    Set RS_CurrDocTbl = db.OpenRecordset(strDocOut, dbOpenDynaset)
            
    Set td = db.TableDefs(strDocOut)
    
    RS_CurrDocTbl.MoveLast
    lngCurrDocTblRecordCount = RS_CurrDocTbl.RecordCount ' count the records - suspect there may be a better way, but I need to populate the recordset anyway.
    RS_CurrDocTbl.MoveFirst
    
    Debug.Print "curr doc tbl record count = " & lngCurrDocTblRecordCount
    
    lngID1 = 0 '1st record ID

    Do While lngID1 < (lngCurrDocTblRecordCount) ' loop through records (first)

        RS_CurrDocTbl.MoveFirst
        RS_CurrDocTbl.Move (lngID1) 'move to 1st rec currently being worked on - Suspect there is a better way of doing this.
             
        ' initialise / clear variables
        strFldNameList = ""
        str1stRecContents = ""
        str2ndRecContents = ""
        
        intFldCount = td.Fields.Count ' get total number of fields
                
            ' Feed the names of the arbitrary fields in this document that contain parameters, into a comma-delimited string
        For Each fldDef In td.Fields
            strFldNameList = strFldNameList & fldDef.Name & ","  ' append this field name to the string, then the delimiting comma - suspect that this is unnecessary?
        Next

        strFldNameList = Left(strFldNameList, Len(strFldNameList) - 1) 'delete final comma from delimited string

        ReDim strFldNameArray(0 To intFldCount - 1)

        ' Create an array from the string and store it into strFldNameArray
        strFldNameArray = Split(strFldNameList, ",")

        ' For the first comparison record, get the contents of the COMP_NAME field and the arbitrary fields containing
        ' parameters and feed them into a concatenated string sequence:

        For intFldIndex = 2 To intFldCount - 2  ' for each of the fields except the 1st (REF), 2nd (NB) and final (COMMENT) fields (note this structure will always be the same)
            strThisFldName = strFldNameArray(intFldIndex) ' get this field name
            str1stRecContents = str1stRecContents & RS_CurrDocTbl(strThisFldName) & ""  ' append the field's contents to the string
        Next
            
            
        strREF1 = RS_CurrDocTbl![REF] & ""
        
        If strREF1 = "" Then 'if ref is blank
            strREF1 = "¿" ' replace with special flag character for later processing
        End If

        intNB1 = RS_CurrDocTbl![NB] ' each record will ALWAYS have a NB - will be an int, usually no more than ~60

        strCOMMENT1 = RS_CurrDocTbl![COMMENT] & ""
        
        If strCOMMENT1 & "" = "" Then
            strCOMMENT1 = "¿" ' if comment is blank then replace with special flag character
        End If

        If Right(strCOMMENT1, 1) <> "~" Then ' if comment does not already contain some comment (from a previous run through) then create new concatenated string
            strCOMMENT1 = strREF1 & "~" & intNB1 & "~" & strCOMMENT1 & "~" ' e.g. "A~3~Cable groove~"
        End If

        Debug.Print "strCOMMENT1 = " & strCOMMENT1

        RS_CurrDocTbl.Edit
        RS_CurrDocTbl![COMMENT] = strCOMMENT1 ' save new comment string into table
        RS_CurrDocTbl.Update

        lngID2 = lngID1 + 1 ' lngID1 is current record, set lngID2 (record to be compared to current record) to initially be the next record in the list

        Do While Not RS_CurrDocTbl.EOF 'loop through records (2nd)

            RS_CurrDocTbl.MoveFirst ' move to first record in table
            RS_CurrDocTbl.Move (lngID2) ' then move [lngID2] spaces forward to seek to correct record for comparisons - suspect there is a better way
                
            str2ndRecContents = "" ' initialise variable / clear from previous run

            If Not RS_CurrDocTbl.EOF Then
                    
                For intFldIndex = 2 To intFldCount - 2  ' for each of the fields except the 1st (REF), 2nd (NB) and final (COMMENT) fields
                    strThisFldName = strFldNameArray(intFldIndex) ' get this field name
                    str2ndRecContents = str2ndRecContents & RS_CurrDocTbl(strThisFldName) & ""  ' append its contents to the string
                Next
            
                strREF2 = RS_CurrDocTbl![REF] & ""
                
                If strREF2 = "" Then ' if ref is blank
                    strREF2 = "¿" ' replace with key character for later processing
                End If

                intNB2 = RS_CurrDocTbl![NB]

                strCOMMENT2 = RS_CurrDocTbl![COMMENT] & ""
                            
                If strCOMMENT2 = "" Then ' if comment is blank
                    strCOMMENT2 = "¿" ' replace with key character for later processing
                End If
                    
                If Right(strCOMMENT2, 1) <> "~" Then
                    strCOMMENT2 = strREF2 & "~" & intNB2 & "~" & strCOMMENT2 & "~" ' e.g. "A~3~Cable groove~"
                End If
                    
                RS_CurrDocTbl.Edit
                RS_CurrDocTbl![COMMENT] = strCOMMENT2
                RS_CurrDocTbl.Update
                    
                Debug.Print "strComment2 = " & strCOMMENT2
                    
                If str1stRecContents = str2ndRecContents Then ' if a match is found

                    RS_CurrDocTbl.Delete ' delete current (2nd) record
                    
                    lngCurrDocTblRecordCount = lngCurrDocTblRecordCount - 1 ' decrement number of records
                    
                    RS_CurrDocTbl.MoveFirst
                    RS_CurrDocTbl.Move (lngID1) ' move to 1st record
                                                
                    RS_CurrDocTbl.Edit
                    RS_CurrDocTbl![NB] = RS_CurrDocTbl![NB] + intNB2 ' add numbers to get total count
                    RS_CurrDocTbl![COMMENT] = RS_CurrDocTbl![COMMENT] & strCOMMENT2
                    RS_CurrDocTbl.Update
                    
                    ' this leaves ref unchanged as this will be processed in a later module by extracting info from the (now combined and concatenated) comment field
                        
                    Debug.Print "Match found - Records combined"
                    
                    Debug.Print "lngCurrDocTblRecordCount = " & lngCurrDocTblRecordCount
            
                Else

                    Debug.Print "No match found"
                    lngID2 = lngID2 + 1 ' only increase ID of 2nd record being compared if it has not just been deleted

                End If ' end record contents comparison

            End If ' end EOF testing
            
        Loop ' end looping through (2nd) records
                
        lngID1 = lngID1 + 1 ' increment 1st record ID
    
        Debug.Print "******* lngID1 = " & lngID1

    Loop ' end looping through (1st) records
        
    RS_tmpTblDocsOutList.MoveNext ' move to next table
    
Loop ' end looping through documents/tables

RS_CurrDocTbl.Close ' close current table
RS_tmpTblDocsOutList.Close ' close list of tables

condenseComments ' call sub which condenses comments
                
Exit Sub
        
        
' General Error Handler:
Exit_Err_General:
Exit Sub

Err_General:
MsgBox "Oops! There's been an error!  Error " & Err.Number & ": " & Err.Description

close_all_open_tables ' what it says

Resume Exit_Err_General

End Sub

Sub condenseOutputDocs()

'If gcfHandleErrors Then On Error GoTo Err_General

Dim strCOMP_NAME As String
Dim strDfltParam As String
Dim strParamsExpOld As String
Dim strParamsExpNew As String
Dim intParamPos As Integer
Dim strREF1 As String
Dim intNB1 As Integer
Dim strCOMP_NAME1 As String
Dim strPAR1 As String
Dim strREF2 As String
Dim strREFnew As String
Dim intNB2 As Integer
Dim strCOMP_NAME2 As String
Dim strPAR2 As String
Dim strCOMMENT1 As String
Dim strCOMMENT2 As String
Dim strCOMMENTnew As String
Dim lngCmntFndPos As Long
Dim intSlashCount As Integer
Dim intCommaCount As Integer
Dim strCmntPrefix As String

Dim td As TableDef
Dim fldDef As Field
Dim strFldNameList As String
Dim strFldNameArray() As String
Dim intFldCount As Integer
Dim intFldIndex As Integer
Dim strThisFldName As String
Dim str1stRecContents As String
Dim str2ndRecContents As String

Dim lngID1 As Long
Dim lngID2 As Long

Dim lngCurrDocTblRecordCount As Long


'------------------------------------------------------------------------------------
' Condenses output documents by combining records where all fields except NB, REF and COMMENT match
'
' Adds NBs from combined fields together to give total number of components
'
' Also takes all REF, NB and COMMENTS and concatenates them into a string separated by the "~" character
' for later processing / recombining - temporarily stored in the COMMENT field.
'
' Also replaces blank fields temporarily with the "¿" character as a special flag for later processing
'
' So for example the following 2 records (note that fields REF, NB, COMP_NAME and COMMENT are present in all tables, but
' there may be any number of fields inbetween COMP_NAME and COMMENT with different names, but COMP_NAME and all of these
' fields must match for a record to be combined):
'
' REF       NB  COMP_NAME       PARAMS          COMMENT
' A         2   RAFTER          L=2000 P=25     BLAH
' B         5   RAFTER          L=2000 P=25     FEH
' C         3   RAFTER          L=2000 P=25     BLAH
' D         2   RAFTER          L=2000 P=25     [BLANK]
' [BLANK]   4   RAFTER          L=2000 P=25     [BLANK]
' [BLANK]   6   RAFTER          L=2000 P=25     FOO
'
' then become as an intermediate step:
'
' REF   NB  COMP_NAME       PARAMS          COMMENT
' A     22  RAFTER          L=2000 P=25     A~2~BLAH~B~5~FEH~C~3~BLAH~D~2~¿~¿~4~¿~¿~6~FOO~
' Lines show separation of records:        |        |       |        |     |     |       |
' (note REF is currently unchanged and will be the REF from the first found record which is matched to others)
' (Also blank values are replaced with ¿ for later processing)
'
' And eventually in a later module will be processed further and become:
'
' REF               NB  COMP_NAME       PARAMS          COMMENT
' A:2,B:5,C:3,D:2   16  RAFTER          L=2000 P=25     [A:2/C:3 - BLAH] [B:5 - FEH] [NoRef:6 - FOO]
'
'-------------------------------------------------------------------------------------

Set db = CurrentDb

Set RS_tmpTblDocsOutList = db.OpenRecordset("tmpTblDocsOutList", dbOpenDynaset) 'tmpTblDocsOutList contains a list of all tables to be processed in this way
'tmbTblDocstOutlist is comstructed earlier in another sub.

Do While Not RS_tmpTblDocsOutList.EOF ' loop through output docs

    strDocOut = RS_tmpTblDocsOutList![OUT_DOCUMENT] & ""
    
    Debug.Print "-------------------------------------------------------------------"
    Debug.Print "strDocOut = " & strDocOut
    
    ' Open a recordset for the document table
    Set RS_CurrDocTbl = db.OpenRecordset(strDocOut, dbOpenDynaset)
            
    Set td = db.TableDefs(strDocOut)
    
    RS_CurrDocTbl.MoveLast
    lngCurrDocTblRecordCount = RS_CurrDocTbl.RecordCount ' count the records - suspect there may be a better way, but I need to populate the recordset anyway.
    RS_CurrDocTbl.MoveFirst
    
    Debug.Print "curr doc tbl record count = " & lngCurrDocTblRecordCount
    
    lngID1 = 0 '1st record ID

    Do While lngID1 < (lngCurrDocTblRecordCount) ' loop through records (first)

        RS_CurrDocTbl.MoveFirst
        RS_CurrDocTbl.Move (lngID1) 'move to 1st rec currently being worked on - Suspect there is a better way of doing this.
             
        ' initialise / clear variables
        strFldNameList = ""
        str1stRecContents = ""
        str2ndRecContents = ""
        
        intFldCount = td.Fields.Count ' get total number of fields
                
            ' Feed the names of the arbitrary fields in this document that contain parameters, into a comma-delimited string
        For Each fldDef In td.Fields
            strFldNameList = strFldNameList & fldDef.Name & ","  ' append this field name to the string, then the delimiting comma - suspect that this is unnecessary?
        Next

        strFldNameList = Left(strFldNameList, Len(strFldNameList) - 1) 'delete final comma from delimited string

        ReDim strFldNameArray(0 To intFldCount - 1)

        ' Create an array from the string and store it into strFldNameArray
        strFldNameArray = Split(strFldNameList, ",")

        ' For the first comparison record, get the contents of the COMP_NAME field and the arbitrary fields containing
        ' parameters and feed them into a concatenated string sequence:

        For intFldIndex = 2 To intFldCount - 2  ' for each of the fields except the 1st (REF), 2nd (NB) and final (COMMENT) fields (note this structure will always be the same)
            strThisFldName = strFldNameArray(intFldIndex) ' get this field name
            str1stRecContents = str1stRecContents & RS_CurrDocTbl(strThisFldName) & ""  ' append the field's contents to the string
        Next
            
            
        strREF1 = RS_CurrDocTbl![REF] & ""
        
        If strREF1 = "" Then 'if ref is blank
            strREF1 = "¿" ' replace with special flag character for later processing
        End If

        intNB1 = RS_CurrDocTbl![NB] ' each record will ALWAYS have a NB - will be an int, usually no more than ~60

        strCOMMENT1 = RS_CurrDocTbl![COMMENT] & ""
        
        If strCOMMENT1 & "" = "" Then
            strCOMMENT1 = "¿" ' if comment is blank then replace with special flag character
        End If

        If Right(strCOMMENT1, 1) <> "~" Then ' if comment does not already contain some comment (from a previous run through) then create new concatenated string
            strCOMMENT1 = strREF1 & "~" & intNB1 & "~" & strCOMMENT1 & "~" ' e.g. "A~3~Cable groove~"
        End If

        Debug.Print "strCOMMENT1 = " & strCOMMENT1

        RS_CurrDocTbl.Edit
        RS_CurrDocTbl![COMMENT] = strCOMMENT1 ' save new comment string into table
        RS_CurrDocTbl.Update

        lngID2 = lngID1 + 1 ' lngID1 is current record, set lngID2 (record to be compared to current record) to initially be the next record in the list

        Do While Not RS_CurrDocTbl.EOF 'loop through records (2nd)

            RS_CurrDocTbl.MoveFirst ' move to first record in table
            RS_CurrDocTbl.Move (lngID2) ' then move [lngID2] spaces forward to seek to correct record for comparisons - suspect there is a better way
                
            str2ndRecContents = "" ' initialise variable / clear from previous run

            If Not RS_CurrDocTbl.EOF Then
                    
                For intFldIndex = 2 To intFldCount - 2  ' for each of the fields except the 1st (REF), 2nd (NB) and final (COMMENT) fields
                    strThisFldName = strFldNameArray(intFldIndex) ' get this field name
                    str2ndRecContents = str2ndRecContents & RS_CurrDocTbl(strThisFldName) & ""  ' append its contents to the string
                Next
            
                strREF2 = RS_CurrDocTbl![REF] & ""
                
                If strREF2 = "" Then ' if ref is blank
                    strREF2 = "¿" ' replace with key character for later processing
                End If

                intNB2 = RS_CurrDocTbl![NB]

                strCOMMENT2 = RS_CurrDocTbl![COMMENT] & ""
                            
                If strCOMMENT2 = "" Then ' if comment is blank
                    strCOMMENT2 = "¿" ' replace with key character for later processing
                End If
                    
                If Right(strCOMMENT2, 1) <> "~" Then
                    strCOMMENT2 = strREF2 & "~" & intNB2 & "~" & strCOMMENT2 & "~" ' e.g. "A~3~Cable groove~"
                End If
                    
                RS_CurrDocTbl.Edit
                RS_CurrDocTbl![COMMENT] = strCOMMENT2
                RS_CurrDocTbl.Update
                    
                Debug.Print "strComment2 = " & strCOMMENT2
                    
                If str1stRecContents = str2ndRecContents Then ' if a match is found

                    RS_CurrDocTbl.Delete ' delete current (2nd) record
                    
                    lngCurrDocTblRecordCount = lngCurrDocTblRecordCount - 1 ' decrement number of records
                    
                    RS_CurrDocTbl.MoveFirst
                    RS_CurrDocTbl.Move (lngID1) ' move to 1st record
                                                
                    RS_CurrDocTbl.Edit
                    RS_CurrDocTbl![NB] = RS_CurrDocTbl![NB] + intNB2 ' add numbers to get total count
                    RS_CurrDocTbl![COMMENT] = RS_CurrDocTbl![COMMENT] & strCOMMENT2
                    RS_CurrDocTbl.Update
                    
                    ' this leaves ref unchanged as this will be processed in a later module by extracting info from the (now combined and concatenated) comment field
                        
                    Debug.Print "Match found - Records combined"
                    
                    Debug.Print "lngCurrDocTblRecordCount = " & lngCurrDocTblRecordCount
            
                Else

                    Debug.Print "No match found"
                    lngID2 = lngID2 + 1 ' only increase ID of 2nd record being compared if it has not just been deleted

                End If ' end record contents comparison

            End If ' end EOF testing
            
        Loop ' end looping through (2nd) records
                
        lngID1 = lngID1 + 1 ' increment 1st record ID
    
        Debug.Print "******* lngID1 = " & lngID1

    Loop ' end looping through (1st) records
        
    RS_tmpTblDocsOutList.MoveNext ' move to next table
    
Loop ' end looping through documents/tables

RS_CurrDocTbl.Close ' close current table
RS_tmpTblDocsOutList.Close ' close list of tables

condenseComments ' call sub which condenses comments
                
Exit Sub
        
        
' General Error Handler:
Exit_Err_General:
Exit Sub

Err_General:
MsgBox "Oops! There's been an error!  Error " & Err.Number & ": " & Err.Description

close_all_open_tables ' what it says

Resume Exit_Err_General

End Sub

Source Link

asked Jun 5, 2014 at 14:05

WhatEvil

MS Access VBA code to compare records in a table and combine data where necessary

I need to process some data which is the output from a CAD system, namely a Bill of Materials.

I've constructed database and written some VBA code to achieve this. An explanation of what this code does is included as comments at the top of the code block below.

This is my first project in Access/VBA and I have expanded upon something which a colleague wrote, so I expect it's pretty awful, but it does work for what I want it to do.

I've just posted one module which does the first step described in the comments block at the start of the code below.

Note I have written "Suspect there is a better way to do this" etc. in the comments of a line which I think is questionable, so if you do a Ctrl+F for "suspect" then you'll find things I am particularly unsure of.

What I'd like to get from this review is:

Tighten this all up functionally, perhaps speed the code up where possible. I suspect that maybe some of my loops, ways of moving through recordsets etc. may be inefficient.
I think perhaps I could be making better use of SQL queries - currently the code doesn't use them but I suspect that using saved queries etc. in some places (executed through VBA) might be quicker than using recordsets in VBA - eg. the parts where records are compared to one another.
Find out where I have done things which are considered bad practice.

I'm less concerned about things like Hungarian notation and making the code pretty.

Sub condenseOutputDocs()

'If gcfHandleErrors Then On Error GoTo Err_General

Dim strCOMP_NAME As String
Dim strDfltParam As String
Dim strParamsExpOld As String
Dim strParamsExpNew As String
Dim intParamPos As Integer
Dim strREF1 As String
Dim intNB1 As Integer
Dim strCOMP_NAME1 As String
Dim strPAR1 As String
Dim strREF2 As String
Dim strREFnew As String
Dim intNB2 As Integer
Dim strCOMP_NAME2 As String
Dim strPAR2 As String
Dim strCOMMENT1 As String
Dim strCOMMENT2 As String
Dim strCOMMENTnew As String
Dim lngCmntFndPos As Long
Dim intSlashCount As Integer
Dim intCommaCount As Integer
Dim strCmntPrefix As String

Dim td As TableDef
Dim fldDef As Field
Dim strFldNameList As String
Dim strFldNameArray() As String
Dim intFldCount As Integer
Dim intFldIndex As Integer
Dim strThisFldName As String
Dim str1stRecContents As String
Dim str2ndRecContents As String

Dim lngID1 As Long
Dim lngID2 As Long

Dim lngCurrDocTblRecordCount As Long


'------------------------------------------------------------------------------------
' Condenses output documents by combining records where all fields except NB, REF and COMMENT match
'
' Adds NBs from combined fields together to give total number of components
'
' Also takes all REF, NB and COMMENTS and concatenates them into a string separated by the "~" character
' for later processing / recombining - temporarily stored in the COMMENT field.
'
' Also replaces blank fields temporarily with the "¿" character as a special flag for later processing
'
' So for example the following 2 records (note that fields REF, NB, COMP_NAME and COMMENT are present in all tables, but
' there may be any number of fields inbetween COMP_NAME and COMMENT with different names, but COMP_NAME and all of these
' fields must match for a record to be combined):
'
' REF       NB  COMP_NAME       PARAMS          COMMENT
' A         2   RAFTER          L=2000 P=25     BLAH
' B         5   RAFTER          L=2000 P=25     FEH
' C         3   RAFTER          L=2000 P=25     BLAH
' D         2   RAFTER          L=2000 P=25     [BLANK]
' [BLANK]   4   RAFTER          L=2000 P=25     [BLANK]
' [BLANK]   6   RAFTER          L=2000 P=25     FOO
'
' then become as an intermediate step:
'
' REF   NB  COMP_NAME       PARAMS          COMMENT
' A     22  RAFTER          L=2000 P=25     A~2~BLAH~B~5~FEH~C~3~BLAH~D~2~¿~¿~4~¿~¿~6~FOO~
' Lines show separation of records:        |        |       |        |     |     |       |
' (note REF is currently unchanged and will be the REF from the first found record which is matched to others)
' (Also blank values are replaced with ¿ for later processing)
'
' And eventually in a later module will be processed further and become:
'
' REF               NB  COMP_NAME       PARAMS          COMMENT
' A:2,B:5,C:3,D:2   16  RAFTER          L=2000 P=25     [A:2/C:3 - BLAH] [B:5 - FEH] [NoRef:6 - FOO]
'
'-------------------------------------------------------------------------------------

Set db = CurrentDb

Set RS_tmpTblDocsOutList = db.OpenRecordset("tmpTblDocsOutList", dbOpenDynaset) 'tmpTblDocsOutList contains a list of all tables to be processed in this way
'tmbTblDocstOutlist is comstructed earlier in another sub.

Do While Not RS_tmpTblDocsOutList.EOF ' loop through output docs

    strDocOut = RS_tmpTblDocsOutList![OUT_DOCUMENT] & ""
    
    Debug.Print "-------------------------------------------------------------------"
    Debug.Print "strDocOut = " & strDocOut
    
    ' Open a recordset for the document table
    Set RS_CurrDocTbl = db.OpenRecordset(strDocOut, dbOpenDynaset)
            
    Set td = db.TableDefs(strDocOut)
    
    RS_CurrDocTbl.MoveLast
    lngCurrDocTblRecordCount = RS_CurrDocTbl.RecordCount ' count the records - suspect there may be a better way, but I need to populate the recordset anyway.
    RS_CurrDocTbl.MoveFirst
    
    Debug.Print "curr doc tbl record count = " & lngCurrDocTblRecordCount
    
    lngID1 = 0 '1st record ID

    Do While lngID1 < (lngCurrDocTblRecordCount) ' loop through records (first)

        RS_CurrDocTbl.MoveFirst
        RS_CurrDocTbl.Move (lngID1) 'move to 1st rec currently being worked on - Suspect there is a better way of doing this.
             
        ' initialise / clear variables
        strFldNameList = ""
        str1stRecContents = ""
        str2ndRecContents = ""
        
        intFldCount = td.Fields.Count ' get total number of fields
                
            ' Feed the names of the arbitrary fields in this document that contain parameters, into a comma-delimited string
        For Each fldDef In td.Fields
            strFldNameList = strFldNameList & fldDef.Name & ","  ' append this field name to the string, then the delimiting comma - suspect that this is unnecessary?
        Next

        strFldNameList = Left(strFldNameList, Len(strFldNameList) - 1) 'delete final comma from delimited string

        ReDim strFldNameArray(0 To intFldCount - 1)

        ' Create an array from the string and store it into strFldNameArray
        strFldNameArray = Split(strFldNameList, ",")

        ' For the first comparison record, get the contents of the COMP_NAME field and the arbitrary fields containing
        ' parameters and feed them into a concatenated string sequence:

        For intFldIndex = 2 To intFldCount - 2  ' for each of the fields except the 1st (REF), 2nd (NB) and final (COMMENT) fields (note this structure will always be the same)
            strThisFldName = strFldNameArray(intFldIndex) ' get this field name
            str1stRecContents = str1stRecContents & RS_CurrDocTbl(strThisFldName) & ""  ' append the field's contents to the string
        Next
            
            
        strREF1 = RS_CurrDocTbl![REF] & ""
        
        If strREF1 = "" Then 'if ref is blank
            strREF1 = "¿" ' replace with special flag character for later processing
        End If

        intNB1 = RS_CurrDocTbl![NB] ' each record will ALWAYS have a NB - will be an int, usually no more than ~60

        strCOMMENT1 = RS_CurrDocTbl![COMMENT] & ""
        
        If strCOMMENT1 & "" = "" Then
            strCOMMENT1 = "¿" ' if comment is blank then replace with special flag character
        End If

        If Right(strCOMMENT1, 1) <> "~" Then ' if comment does not already contain some comment (from a previous run through) then create new concatenated string
            strCOMMENT1 = strREF1 & "~" & intNB1 & "~" & strCOMMENT1 & "~" ' e.g. "A~3~Cable groove~"
        End If

        Debug.Print "strCOMMENT1 = " & strCOMMENT1

        RS_CurrDocTbl.Edit
        RS_CurrDocTbl![COMMENT] = strCOMMENT1 ' save new comment string into table
        RS_CurrDocTbl.Update

        lngID2 = lngID1 + 1 ' lngID1 is current record, set lngID2 (record to be compared to current record) to initially be the next record in the list

        Do While Not RS_CurrDocTbl.EOF 'loop through records (2nd)

            RS_CurrDocTbl.MoveFirst ' move to first record in table
            RS_CurrDocTbl.Move (lngID2) ' then move [lngID2] spaces forward to seek to correct record for comparisons - suspect there is a better way
                
            str2ndRecContents = "" ' initialise variable / clear from previous run

            If Not RS_CurrDocTbl.EOF Then
                    
                For intFldIndex = 2 To intFldCount - 2  ' for each of the fields except the 1st (REF), 2nd (NB) and final (COMMENT) fields
                    strThisFldName = strFldNameArray(intFldIndex) ' get this field name
                    str2ndRecContents = str2ndRecContents & RS_CurrDocTbl(strThisFldName) & ""  ' append its contents to the string
                Next
            
                strREF2 = RS_CurrDocTbl![REF] & ""
                
                If strREF2 = "" Then ' if ref is blank
                    strREF2 = "¿" ' replace with key character for later processing
                End If

                intNB2 = RS_CurrDocTbl![NB]

                strCOMMENT2 = RS_CurrDocTbl![COMMENT] & ""
                            
                If strCOMMENT2 = "" Then ' if comment is blank
                    strCOMMENT2 = "¿" ' replace with key character for later processing
                End If
                    
                If Right(strCOMMENT2, 1) <> "~" Then
                    strCOMMENT2 = strREF2 & "~" & intNB2 & "~" & strCOMMENT2 & "~" ' e.g. "A~3~Cable groove~"
                End If
                    
                RS_CurrDocTbl.Edit
                RS_CurrDocTbl![COMMENT] = strCOMMENT2
                RS_CurrDocTbl.Update
                    
                Debug.Print "strComment2 = " & strCOMMENT2
                    
                If str1stRecContents = str2ndRecContents Then ' if a match is found

                    RS_CurrDocTbl.Delete ' delete current (2nd) record
                    
                    lngCurrDocTblRecordCount = lngCurrDocTblRecordCount - 1 ' decrement number of records
                    
                    RS_CurrDocTbl.MoveFirst
                    RS_CurrDocTbl.Move (lngID1) ' move to 1st record
                                                
                    RS_CurrDocTbl.Edit
                    RS_CurrDocTbl![NB] = RS_CurrDocTbl![NB] + intNB2 ' add numbers to get total count
                    RS_CurrDocTbl![COMMENT] = RS_CurrDocTbl![COMMENT] & strCOMMENT2
                    RS_CurrDocTbl.Update
                    
                    ' this leaves ref unchanged as this will be processed in a later module by extracting info from the (now combined and concatenated) comment field
                        
                    Debug.Print "Match found - Records combined"
                    
                    Debug.Print "lngCurrDocTblRecordCount = " & lngCurrDocTblRecordCount
            
                Else

                    Debug.Print "No match found"
                    lngID2 = lngID2 + 1 ' only increase ID of 2nd record being compared if it has not just been deleted

                End If ' end record contents comparison

            End If ' end EOF testing
            
        Loop ' end looping through (2nd) records
                
        lngID1 = lngID1 + 1 ' increment 1st record ID
    
        Debug.Print "******* lngID1 = " & lngID1

    Loop ' end looping through (1st) records
        
    RS_tmpTblDocsOutList.MoveNext ' move to next table
    
Loop ' end looping through documents/tables

RS_CurrDocTbl.Close ' close current table
RS_tmpTblDocsOutList.Close ' close list of tables

condenseComments ' call sub which condenses comments
                
Exit Sub
        
        
' General Error Handler:
Exit_Err_General:
Exit Sub

Err_General:
MsgBox "Oops! There's been an error!  Error " & Err.Number & ": " & Err.Description

close_all_open_tables ' what it says

Resume Exit_Err_General

End Sub

Many thanks for your help.

sql vba ms-access