Skip to main content
added 105 characters in body
Source Link
RubberDuck
  • 31.2k
  • 6
  • 74
  • 177

Here you're moving to the first record, and then immediately moving to the lngID1th record each time though your loop. No need to .movefirst. You should gain some performance by removing thisprobably just find the matching records instead. It would save you a few iterations I think.

Here you're moving to the first record, and then immediately moving to the lngID1th record each time though your loop. No need to .movefirst. You should gain some performance by removing this.

Here you're moving to the first record, and then immediately moving to the lngID1th record each time though your loop. You should probably just find the matching records instead. It would save you a few iterations I think.

Source Link
RubberDuck
  • 31.2k
  • 6
  • 74
  • 177

This is a huge improvement over the last version. I'll try to give you some pointers on how to improve this farther, but I am also going to tell you this. Your database is very poorly designed (if not downright broken) and nothing we do here will fix that. If you were using proper keys on your database, you might be able to develop a sql solution to this. You use REF as a key, but don't have it defined as such. That column should not allow nulls. Period. I suspect that is the source of your woes and the rest of this is a symptom of that. Now that that's out of the way, let's see what we can do short term to clean this up further...

Why are you adding an empty string to the end of strDocOut? That doesn't do anything at all. (Note: I just found several more instances of this. I really don't understand it.)

strDocOut = RS_tmpTblDocsOutList![OUT_DOCUMENT] & vbNullString

Here you're moving to the first record, and then immediately moving to the lngID1th record each time though your loop. No need to .movefirst. You should gain some performance by removing this.

    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 '!!REMOVE THIS!!
        RS_CurrDocTbl.Move (lngID1)    'move to 1st rec currently being worked on - Suspect there is a better way of doing this.

A couple of lines down from there, you're creating a comma delimited string of Field Names.

        ' 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

This executes for each record in the table. You only need to do this once; outside of the loop.

...and then you split it onto an array. Which I guess is ok because you don't want to check the first or last records for some reason. There's something smelly here, but I don't see how to fix it. Maybe another reviewer can comment on that.

Now we're into the third loop. Again, There's no reason to .movefirst. Just call RS_CurrDocTbl.Move (lngID2).

I can't quite figure out what you're doing here, but you probably want a series of SQL delete & update statements instead.

                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

Something like:

Insert foo,bar Into tmpTblDocsOutList Where ...

And

Delete tmpTblDocsOutList
From tmpTblDocsOutList docs1
Inner Join tmpTblDocsOutList docs2
    On docs1.key = docs2.key
Where ....

I'm sorry. I just can't follow the logic well enough to give you a query closer to what you'll actually need. You might also want to consider creating a new temp table to insert data into temporarily. Once you have that the way you want it, you can delete all of the records from tmpDocsOutList instead of trying to preserve just one record.