kfschaefer
Registered User.
- Local time
- Today, 03:49
- Joined
- Oct 10, 2008
- Messages
- 58
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
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.
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
Karen