Revised Comments without Deleting existing Comment data (1 Viewer)

[kfschaefer]

I need help with the attached code to prevent duplicate entry of data within a Comment field(Memo). I need to validate if certain data exists within the Comments, if so only modify the necessary data and not duplicate the data.

The problem I am having in my code is with the replacement of the field("REQ EMO") data within the comment field, it is currently duplicate the data instead of updating it. See the attached image for illustrating my point.

See '>>>>>>>>>>> in code for problem area.

Private Sub cmdCopyWSNo_Click()
    Dim MaxWidth(1 To 3) As Long
    Dim iEMO(4) As Long
    Dim i As Integer
    
    MaxWidth(1) = 15
    MaxWidth(2) = 10
    MaxWidth(3) = 0

    Set curDB = Application.CurrentDb
    sFieldName = vbNullString
    recValue = vbNullString
    strSQL = vbNullString
    
    Select Case Me.Work_Code
        Case 1, 3
            gWC = Me.Work_Code.Column(1)
    End Select
    
    gJG = Me.Job_Group
    gLab = Me.Cmis_Lab
    
    strSQL = "SELECT *" & _
            " FROM tblEquipListingPerJobGroup" & _
            " WHERE (Job_Group=" & Chr(39) & gJG & Chr(39) & ")"
    
    Set rs = curDB.OpenRecordset(strSQL)
    
    sFieldName = UCase(SPad(rs.Fields("Equipment_ID").Name, MaxWidth(1)))
    sFieldName = UCase(sFieldName & SPad(rs.Fields("MeasNo").Name, MaxWidth(2)))
    sFieldName = UCase(sFieldName & SPad(rs.Fields("WSNo").Name, MaxWidth(3)))
    
    If Nz(Me.RequestorComments) = "" Then
        If gLab = "F100" Then
            recValue = "WORK CODE: " & gWC
            GoSub MyUpdate
        Else
            'Data from tblEquipListingPerJobGroup
            With rs
                If Not (.BOF And .EOF) Then
                    .MoveFirst
                    Do Until .EOF
                        If recValue <> "" Then recValue = recValue & RSLF
                        recValue = recValue & SPad(.Fields("Equipment_ID"), MaxWidth(1))
                        recValue = recValue & SPad(.Fields("MeasNo"), MaxWidth(2))
                        recValue = recValue & SPad(.Fields("WSNo"), MaxWidth(3))
                        .MoveNext
                    Loop
                End If
            End With
            recValue = sFieldName & RSLF & recValue & RSLF & "WORK CODE: " & gWC
            Me.RequestorComments = recValue & gOrigComment
            GoTo ResumeNext:
        End If
    
    ElseIf Nz(Me.RequestorComments) <> "" Then
        If gLab = "F100" Then
            recValue = "WORK CODE: " & gWC
            GoSub MyUpdate
        'Data from tblEquipListTemp
        Else
            With rs
                If Not (.BOF And .EOF) Then
                    .MoveFirst
                    Do Until rs.EOF
                        If recValue <> "" Then recValue = recValue & RSLF
                        recValue = recValue & SPad(.Fields("Equipment_ID"), MaxWidth(1))
                        recValue = recValue & SPad(.Fields("MeasNo"), MaxWidth(2))
                        recValue = recValue & SPad(.Fields("WSNo"), MaxWidth(3))
                        .MoveNext
                    Loop
                End If
            End With
        recValue = sFieldName & RSLF & recValue & RSLF & "WORK CODE: " & gWC
        End If
    End If
    '---------------------------------------------------------------------------------------
  '>>>>>>>>>>>  'copy Req EMO data into Comments field.
    '---------------------------------------------------------------------------------------
    If Not IsNull(Me.RequestorComments) = True Then
        If InStr(Me.RequestorComments, "Req Emo") = 0 Then
            gEMO1 = Me.REQ_EMO1
            gEMO2 = Me.REQ_EMO2
            gEMO3 = Me.REQ_EMO3
            gEMO4 = Me.REQ_EMO4
        
            If Not IsNull(gEMO1) Or Not IsNull(gEMO2) Or Not IsNull(gEMO3) Or Not IsNull(gEMO4) Then
                iEMO(1) = gEMO1
                iEMO(2) = gEMO2
                iEMO(3) = gEMO3
                iEMO(4) = gEMO4
                
                For i = 1 To 4
                    If iEMO(i) > 0 Then
                      recValue = recValue & RSLF & "Req Emo" & i & ":   " & iEMO(i)
                    End If
                Next
            End If
    '    Debug.Print recValue
        ElseIf InStr(Me.RequestorComments, "Req EMO") > 0 Then

            Select Case _
                MsgBox("The Comments of this Service Request Record, currently contains REQ EMO data, Do you wish to replace Req EMO Data?", _
                vbYesNo Or vbExclamation Or vbDefaultButton1, "Req EMO Data")
            
                Case vbYes
                    gEMO1 = Me.REQ_EMO1
                    gEMO2 = Me.REQ_EMO2
                    gEMO3 = Me.REQ_EMO3
                    gEMO4 = Me.REQ_EMO4
                    If Not IsNull(gEMO1) Or Not IsNull(gEMO2) Or Not IsNull(gEMO3) Or Not IsNull(gEMO4) Then
                        iEMO(1) = gEMO1
                        iEMO(2) = gEMO2
                        iEMO(3) = gEMO3
                        iEMO(4) = gEMO4
                        
                        For i = 1 To 4
                            If iEMO(i) > 0 Then
                              recValue = recValue & RSLF & "Req Emo" & i & ":   " & iEMO(i)
                            End If
                        Next
                    End If
                      GoSub MyUpdate:
                  GoTo ResumeNext:
                Case vbNo
                    GoTo ResumeNext:
            End Select
        End If
'GoSub MyUpdate:
        
    End If
    'Modify Comments on the SR Main form
MyUpdate:
    Set gcomments = Me.Controls("RequestorComments")
    strSearchFor = GetCommentData.TestEquipmentDetails
    Set gcomments = Nothing
    strReplaceWith = recValue
    strSearch = Nz(Me.RequestorComments)
    
    If strSearchFor = "" Then
        gValue = strReplaceWith & RSLF & strSearch
    Else
        gValue = Replace(strSearch, strSearchFor, strReplaceWith)
    End If
    Me.RequestorComments = gValue
    GoTo ResumeNext:
    
    Return
    
ResumeNext:
    rs.Close
    Set rs = Nothing
    Me.RequestorComments.Requery
    Me.Repaint
    
End Sub

Function SPad(ByVal InString As Variant, Optional ByVal PadToWidth As Long = 0, _
    Optional ByVal PadChar As String = " ") As String
    'returns string InString padded with character PadChar to a total width of PadToWidth characters
    'PadToWidth positive values: padding added to end (right) of string InString
    'PadToWidth negative values: padding added to beginning (left) of string InString
    Dim n As Long
    If Len(Nz(InString)) < PadToWidth Then
        For n = 1 To Abs(PadToWidth) - Len(Nz(InString))
            SPad = SPad & PadChar
        Next n
    End If
    Select Case PadToWidth
        Case Is > 0
            SPad = Nz(InString) & SPad
        Case Is < 0
            SPad = SPad & Nz(InString)
        Case Else
            SPad = Nz(InString)
    End Select
End Function

Thanks,
Karen