Text Replacement Algorithm Drops Single Character at End of Strings -- Please Review

[AlexB123]

Hi all,

I have several hundred thousand business rules I need to edit. I have a list of codes to remove from the strings, and so I created an Access Form button that runs VBA to check for certain conditions, and if those conditions are met, to cycle through my list of codes to remove. It seems to work pretty well ... the last thing I need to address is that in long strings ending with a ")" it drops the parenthesis. If anyone could review my code and make suggestions I would be very, very thankful!!!

Option Compare Database

Private Sub Command0_Click()

    Dim i As Integer
 
    'Declare DAO recordset and populate with data from our table
    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_SVP_TEST;")
 
    'Declare array of code values to replace or delete out
    Dim code As Variant: code = Array("S3", "Q1")
     
   'Create working column, a copy of original column OLD_SVP to NEW_SVP
        DoCmd.SetWarnings False
        DoCmd.OpenQuery "qry_SET_NEW_SVP"
        DoCmd.SetWarnings True
     
        'Loop through each row of the recordset
        Do Until rs.EOF = True
 
            Dim count As Integer
            Dim strCnt As Integer
            Dim str As String
          
            count = Len(rs!OLD_SVP) - Len(Replace(rs!OLD_SVP, "'", "")) 'count of tics in each row
            strCnt = count / 2 'count of substrings in each row
         
            'Loop through each code
            For i = 0 To 1
             
                'Declare our test cases
                Dim tst1 As String: tst1 = "'" & code(i) & ","
                Dim tst2 As String: tst2 = "," & code(i) & "'"
                Dim tst3 As String: tst3 = "," & code(i) & ","
                Dim str1 As String
                Dim str2 As String
                Dim str3 As String
                Dim intTic1 As String
                Dim intTic2 As String
                             
                'for each substring, if and only iff tests true for the code and true for 'X028' then perform string processing
                For m = 0 To strCnt
             
                    'I need the initial str to be equl to rs!NEW_SVP only on the first run, otw equal to updated str3
                    If i = 0 And m = 0 Then
                        str = rs!NEW_SVP 'Set string to record
                    ElseIf i <> 0 And m = 0 Then
                            str = newstr
                    Else
                        str = str3
                    End If
             
                    If Nz(str, "") <> "" Then
                        'Find first tick
                        intTic1 = InStr(1, str, "'", vbTextCompare)
                        If intTic1 > 0 Then
                            'Find second tick
                            intTic2 = InStr(intTic1 + 1, str, "'", vbTextCompare)

                            If intTic2 > 0 Then
                             
                                'break into substrings for processing
                                str1 = Left(str, intTic1 - 1)
                                str2 = Mid(str, intTic1, intTic2 - (intTic1) + 1)
                                str3 = Right(str, Len(str) - intTic2) 'saved for next loop processing (end of string)
                             
                                                             
                                'test if str1 contains service code
                                If InStr(1, str1, "X028", vbTextCompare) > 0 Then
                                                                 
                                    Dim testval As String
                                 
                                    'test if str2 contains code to be deleted
                                    If InStr(str2, code(i)) > 0 Then
                                     
                                        testval = Nz(Mid(str2, InStr(str2, code(i)) - 1, 4))
             
                                        If testval = tst1 Then
                                            str2 = "'" & Replace(str2, testval, "")
                                        ElseIf testval = tst2 Then
                                            str2 = Replace(str2, testval, "") & "'"
                                        ElseIf testval = tst3 Then
                                            str2 = Left(str2, InStr(str2, testval)) & Right(str2, Len(str2) - InStr(str2, testval) - 3)
                                        End If
                                    End If
                                End If
                                 
                                'newstrings to be assembled after all substrings processed
                                If m = 0 Then
                                    If Len(str3) < 3 Then
                                        newstr = str1 & str2 & str3
                                    Else
                                        newstr = str1 & str2
                                    End If
                                Else
                                    If Len(str3) < 3 Then
                                        newstr = newstr & str1 & str2 & str3
                                    Else
                                        newstr = newstr & str1 & str2
                                    End If
                                End If
                         
                            End If
                     
                        End If
                 
                    End If
             
                Next m

            Next i
         
            rs.Edit
            rs!NEW_SVP = newstr
            rs.Update
             
            'Move to next record and start loop over
            rs.MoveNext
        Loop

rs.Close
Set rs = Nothing

MsgBox "Done!"

End Sub

My query "qry_SET_NEW_SVP" just copies the data to a new column so that I can edit the new column.

UPDATE tbl_SVP_TEST SET NEW_SVP = OLD_SVP;

And some sample data:

X028 NE ('S3,XT,NT,NS,XQ,C1')

X028 NE 'XA,JA,XB,XC,S3,XD,NA,NB,XE,XF,C1,Q1'

(T022 EQ 'L,+,=,Q,W,4,8,4,9') OR (X028 EQ 'BT,BX,BY,ST,XX,XY,YA,YB,YF,YH,YU,YI' AND P467 EQ '6,7,8' AND P103 NE '0') OR (X028 EQ 'BT,BX,BY,ST,XX,XY,YA,YB,YF,YH,YU,YI' AND P467 NE '6,7,8') OR (P467 NE '6,7,Q1' AND P103 NE '0')

X028 EQ 'XI,P1,ST,QT,S3' OR (P467 NE '1,8,Q1' AND P103 NE '2')

 

[welshgasman]

I would be selecting long strings that have a ) at the end and then walk through the code, line by line to start with.?
Most likely where you are using len() all over the place?

Only you know this code and data intimately?

 

[xenou]

I would guess you should check all your string functions that take a parameter for length. Like Left(), Mid(), Right(), Instr() -- make sure you are not getting an off-by-one error (like thinking the parameter is one-based when it is zero-based or vice versa).

I would also find a case that is not working and test that case - step through your code line by line.

 

[AlexB123]

Thank you both! I was able to edit my code and get it to work.

Do you see any obvious syntax errors for working with DAO?

 

[welshgasman]

Do you see any obvious syntax errors for working with DAO?

No, but then I am not an expert? :D