asked on

Revised Comments without Deleting existing Comment data

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.

see previous post: https://www.experts-exchange.com/questions/24422385/i-need-to-align-the-text-w-i-a-Memo-field-to-column-headings-w-i-memo.html?sfQueryTermInfo=1+10+30+byval+instr+spad+variant

Thanks,

Karen

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

Open in new window

REQ-EMO.png

Karen Schaefer

ASKER

Still Looking for assistances - What happen to the request Attention button

Karen Schaefer

ASKER

Please help - need assistance.

Jeffrey Coachman

You should know the drill by now...
;-)

Without a sample DB, ..."Figuring out" what is in your DB will be difficult, ...agreed?

Sample database notes:
1. Back up your database(s).
2. Combine the front and back ends into one database file.
3. Remove any startup options, unless they are relevant to the issue.
4. Remove any records unless they are relevant to the issue.
5. Delete any objects that do not relate directly to the issue.
6. Remove any references to any "linked" files (files outside of the database, Images, OLE Files, ...etc)
7. Remove any references to any third party Active-x Controls (unless they are relevant to the issue)
8. Remove, obfuscate, encrypt, or otherwise disguise, any sensitive data.
9. Compile the code. (From the VBA code window, click: Debug-->Compile)
10. Run the compact/Repair utility.
11. Remove any Passwords and/or security.
12. If a form is involved in the issue, set the Modal and Popup properties to: No
(Again, unless these properties are associated with the issue)
13. Post the explicit steps to replicate the issue.
14. Test the database before posting.

In other words, ...post a database that we can easily open and immediately see and/or troubleshoot the issue.
And if applicable, also include a clear graphical representation of the *Exact* results you are expecting, based on the sample data.

At least with a sample, you stand a chance...

Jeff

Jeffrey Coachman

Perhaps you should hold off on this this Q until:
https://www.experts-exchange.com/questions/27401361/Remove-Delete-then-Replace-a-portion-of-a-Memo-field.html
...is resolved, ...to avoid confusion...

ASKER CERTIFIED SOLUTION

Karen Schaefer

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Karen Schaefer

ASKER

found solution elsewhere