Results 1 to 8 of 8
  1. #1
    Join Date
    May 2006
    Posts
    31

    Unanswered: 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.

    Thanks,

    Karen
    Code:
    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
    Attached Thumbnails Attached Thumbnails REQ_EMO.png  

  2. #2
    Join Date
    Nov 2004
    Location
    out on a limb
    Posts
    13,692
    Provided Answers: 59
    consider pushing the comments to a 'child' table, with a primary key of the 'parent' table and the date & time of the comment
    make the child table read write only don't allow updates
    I'd rather be riding on the Tiger 800 or the Norton

  3. #3
    Join Date
    May 2006
    Posts
    31
    Thanks for the quick response, however - not sure what you are saying- I cannot have multiple records for comments - do to issue of exporting the data to another data source that cannot handle the multiple comment records - Hence needing to update by replacing existing comments data within the same comment record(field). The first part of my code replaces the data correctly for the EquipNo, MeasNo, WSNO, and the Work Code:, it is when I try to replace the REQ EMO data within existing Commments that I am getting duplicate data instead of replacing the necessary changes.

    Any Ideas why this is duplicating?

    K
    Last edited by kfschaefer; 10-17-11 at 16:16.

  4. #4
    Join Date
    Nov 2004
    Location
    out on a limb
    Posts
    13,692
    Provided Answers: 59
    why can you not have multiple comments?
    I'd rather be riding on the Tiger 800 or the Norton

  5. #5
    Join Date
    May 2006
    Posts
    31
    I cannot have multiple records for comments - do to issue of exporting the data to another data source that cannot handle the multiple comment records - that is out of my hands- the export source is program only to handle single line records and the code is locked down.

    k

  6. #6
    Join Date
    Jun 2005
    Location
    Richmond, Virginia USA
    Posts
    2,763
    Provided Answers: 19
    Am I reading your post correctly; are you saying that you're storing EquipNo, MeasNo, WSNO, and REQ EMO all within a single Memo Field?


    Linq ;0)>
    Hope this helps!

    The problem with making anything foolproof...is that fools are so darn ingenious!

    All posts/responses based on Access 2003/2007

  7. #7
    Join Date
    May 2006
    Posts
    31
    that is correct - due to the necessary export requirements, those data fields must also be displayed in the Comments field.

    Here is my revised code - it will replace the first two of the Req EMo #s, but then duplicates the last. SEE THE ATTACHED EXAMPLE.

    1. Intial Entry ReqEMO
    2. Intial Results in Comments.
    3. Modify REQEMO data, Saved REcord, see Problem with results entered into the Comments. Not that the changed data is updated, however, it is stil duplicating the last 2 REQEMOs.

    Note I added an integer check to validate when to execute the portion of the code to copy the REQ EMOs.

    Code:
    Private Sub cmdCopyWSNo_Click()
        Dim MaxWidth(1 To 3) As Long
        Dim iEMO(4) As Long
        Dim i As Integer
        Dim a As Integer    
        MaxWidth(1) = 15
        MaxWidth(2) = 10
        MaxWidth(3) = 0
    
        Set curDB = Application.CurrentDb
        sFieldName = vbNullString
        recValue = vbNullString
        strSQL = vbNullString
        a = 0    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 = Nz(Me.REQ_EMO1)
                gEMO2 = Nz(Me.REQ_EMO2)
                gEMO3 = Nz(Me.REQ_EMO3)
                gEMO4 = Nz(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
            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
                        a = 1                    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
        End If
        'Modify Comments on the SR Main form
    MyUpdate:
        Set gcomments = Me.Controls("RequestorComments")
    '>>>>>>>>>>>>>>>>>>>>>>
        If a = 1 Then
            strSearchFor = GetCommentData_EMO.TestEquipmentDetails
        Else
            strSearchFor = GetCommentData.TestEquipmentDetails
        End If'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
       Set gcomments = Nothing
       ' Debug.Print strSearchFor
        strReplaceWith = recValue
       ' Debug.Print strReplaceWith
        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
    
    Public Function GetCommentData_EMO() As CommentData
        Dim SX() As String
        Dim SY() As String
        Dim i As Long
        Dim n As Long
        Dim blnEMOFound As Boolean
        
       On Error GoTo GetCommentData_EMO_Error
    
        If gcomments Is Nothing Then Exit Function
        
        SX = Split(Nz(gcomments), RSLF)
        
        'look through array elements for work code
        For n = LBound(SX) To UBound(SX)
            If Trim(SX(n)) Like sEMO Then
                blnEMOFound = True
                Exit For
            End If
        Next n
        
        With GetCommentData_EMO
        
            Select Case n
                Case Is > UBound(SX)
                    'Req EMO not found within requestor comments
                    .OriginalComment = Nz(gcomments)
                    .TestEquipmentDetails = ""
                Case UBound(SX)
                    'Req EMO found within requestor comments as last element
                    .OriginalComment = ""
                    .TestEquipmentDetails = Join(SX, RSLF)
                    
                Case Is < UBound(SX)
                    'Req EMO found within requestor comments at element n
                    SY = SX
                    ReDim Preserve SY(LBound(SY) To n)
                    .TestEquipmentDetails = Join(SY, RSLF)
                    n = n + 1
                    For i = LBound(SX) + n To UBound(SX)
                        SX(i - n) = SX(i)
                    Next i
                    ReDim Preserve SX(LBound(SX) To UBound(SX) - n)
                    .OriginalComment = Join(SX, RSLF)
            End Select
            
        End With
    
       On Error GoTo 0
       Exit Function
    
    GetCommentData_EMO_Error:
    
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetCommentData_EMO of Module Functions"
     
    End Function
    Attached Thumbnails Attached Thumbnails REQ_EMO.png   REQEMO_RESULTS.jpg  

  8. #8
    Join Date
    May 2006
    Posts
    31
    Turns out to retain a portion of the searchfor data - need to modify the Replace portion of the code.

    K

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •