• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 325
  • Last Modified:

Strip out extra vbcrlf from middle of comments field.

see previous post http://www.experts-exchange.com/Microsoft/Development/MS_Access/Q_27401361.html

I created an update code that updates a memo field with values from multiple fields on a form for export reasons.

the only problem I am still having is that on the second pass of the code to update existing memo data it wants to insert extra linefeeds between the updated data and the existing data.

this is what it is suppose to look like
.  
 no space added
This is what happens the next time I update the comments for the same record.  Note the extra space (vbcrlf) added in between the text.

Extra spaces added
see: '>>>>>>>>>> effective code.
Public Function GetCommentData_EMO() As CommentData

On Error GoTo ProcError

Dim SX() As String
Dim SY() As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim n As Long
Dim x As Long
Dim blnEMOFound As Boolean
Dim varComments As Variant


    If gComments Is Nothing Then Exit Function
    
    SX = Split(Nz(gComments), vbCrLf)
    'look through array elements for work code
    For n = LBound(SX) To UBound(SX)
        If Trim(SX(n)) Like sEMO Then  'Const sEMO As String = "Req*EMO*"
            If blnEMOFound = False Then
               k = n
               blnEMOFound = True
            End If
            
            j = j + 1
        End If
        
    Next n
    n = n - 1  '<---Needed?
    
    With GetCommentData_EMO
    'Get stuff prior to REQs
        ReDim Preserve SY(LBound(SX) To k - 1)
        For x = LBound(SX) To (k - 1)
          SY(x) = SX(x)
        Next x
    'Get REQs
        If Len(gstrReq) > 0 Then
            ReDim Preserve SY(LBound(SY) To UBound(SY) + 1)
            SY(UBound(SY)) = gstrReq
        End If
    'Get stuff after REQs
        ReDim Preserve SY(LBound(SY) To n)
            For x = (k + j) To UBound(SX)
                SY(x) = SX(x)
            Next x
 '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>       
        'Print results:
           For x = LBound(SY) To UBound(SY)
              varComments = varComments & (SY(x) + vbCrLf)
           Next x
        Debug.Print varComments
              If Len(varComments) > 0 Then
                 varComments = Mid(varComments, 1, InStrRev(varComments, vbCrLf) - 1)
              End If
 '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>              
            'Insert result to Comments box
            Forms!frmSR_Main!RequestorComments = varComments
    End With

ExitProc:
   Exit Function
ProcError:
   MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetCommentData_EMO of Module Functions"
   Resume ExitProc
   Resume
End Function

Open in new window

0
Karen Schaefer
Asked:
Karen Schaefer
  • 4
  • 4
  • 3
  • +2
2 Solutions
 
mbizupCommented:
Karen,

Try this modification:

 '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>              
            'Insert result to Comments box
            if Right(varComments,1) = vbCRLF then varComments = Left(varComments,Len(varComments) - 1)
            Forms!frmSR_Main!RequestorComments = varComments
    End With

0
 
Patrick MatthewsCommented:
Miriam's suggestion needs a tweak:

            if Right(varComments,2) = vbCRLF then varComments = Left(varComments,Len(varComments) - 1)

Carriage return and line feed are two separate characters :)
0
 
mbizupCommented:
Good catch!
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
mbizupCommented:
Limited posting  skills on my phone here, but I think the correction using 2 is needed at the end of that statement too.
0
 
aikimarkCommented:
@kfschaefer1

1. Will there be additions or deletions to the REQ EMO lines or just updates?

2. Looking at acceptable memo field states in both this and prior question threads, you don't really seem to mind if there is a blank line between the last of the REQ EMO lines and the next data line.  Please confirm whether no or single blank lines are acceptable.

3. After updating, I would recommend using Join(varComments, vbcrlf) function to complement your Split() function.  Then eliminate blank lines with
Do
  Replace(varComments, vbcrlf & vbcrlf, vbcrlf)
Loop Until Instr(varComments, vbcrlf & vbcrlf) = 0

Open in new window

0
 
Helen FeddemaCommented:
Try this function:
Public Function StripCRs(strText As String) As String
'Strips CRs from a text string
'Created by Helen Feddema 10-15-97
'Modified by Ruud H.G. van Tol 6-18-99
'Modified by Brad Beacham 6-Feb-2005
'Last modified by Helen Feddema 23-Oct-2011

On Error GoTo ErrorHandler

    Dim strTestString As String
    Dim strBadChar As String
    Dim i As Integer
    Dim strStripChars As String

    strStripChars = Chr(10) & Chr(13)
    strTestString = strText

    For i = 1 To Len(strStripChars)
        strBadChar = Mid(strStripChars, i, 1)
        strTestString = Replace(strTestString, strBadChar, vbNullString)
    Next

    StripCRs = strTestString

ErrorHandlerExit:
   Exit Function

ErrorHandler:
   MsgBox "Error No: " & Err.Number & "; Description: " & _
      Err.Description
   Resume ErrorHandlerExit

End Function

Open in new window

0
 
Helen FeddemaCommented:
I use variations of this function to remove all non-alphanumeric characters, characters that should not be used in file names, or CRs and other low-number ASCII characters.  strStripChars can be set to any string of characters you want to remove, either literally or using the Chr() function.
0
 
Helen FeddemaCommented:
You can replace the CRs with a space, rather than just removing them, if you wish.
0
 
Karen SchaeferAuthor Commented:
Helen,

Thanks for your suggestion, however, your code strips out to many spaces.  I need the data to be displayed as in Picture2 above - minus the extra carriage returns after the last REQ_EMO4.  There should only be 1 CR after this position, then the remaining comments that are added by the user.
------------------------------------------------------------------
aikimark:

Your suggestions does not compile. the replace  syntax seems to be the problem.

------------------------------------------
matthewspatrick/mbzip:

your suggestion does not compile, get Subscript out of range Error message

Thanks for all your suggestions.
K
0
 
mbizupCommented:
Try modifying your code starting at line 50 like this:

        'Print results:
           For x = LBound(SY) To UBound(SY)
              varComments = varComments & (SY(x) + iif(x <> UBound(SY), vbCrLf,""))
           Next x
0
 
Karen SchaeferAuthor Commented:
That sill adds lines between REQ and the users comments.

Here is my sample mdb.  maybe this will help - see the code for GetCommentData_EMO.  

Please use 2003 to make any modifications - do not attempt to use 2007 to save as 2003 - this seems to corrupt my mdb. - not sure why.
Test.zip
0
 
aikimarkCommented:
This should compile cleanly

Do
  varComments = Replace(varComments, vbcrlf & vbcrlf, vbcrlf)
Loop Until Instr(varComments, vbcrlf & vbcrlf) = 0

Open in new window

0
 
Karen SchaeferAuthor Commented:
Thanks for the great Assist.  A combination of  aikimark and mbzip code made the difference.
0
 
Karen SchaeferAuthor Commented:
Here is the final code:
Public Function GetCommentData_EMO() As CommentData

On Error GoTo ProcError

Dim SX() As String
Dim SY() As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim n As Long
Dim x As Long
Dim blnEMOFound As Boolean
Dim varComments As Variant


    If gComments Is Nothing Then Exit Function
    
    SX = Split(Nz(gComments), vbCrLf)
    'look through array elements for work code
    For n = LBound(SX) To UBound(SX)
        If Trim(SX(n)) Like sEMO Then  'Const sEMO As String = "Req*EMO*"
            If blnEMOFound = False Then
               k = n
               blnEMOFound = True
            End If
            
            j = j + 1
        End If
        
    Next n
    n = n - 1  '<---Needed?
    
    With GetCommentData_EMO
    'Get stuff prior to REQs
        ReDim Preserve SY(LBound(SX) To k - 1)
        For x = LBound(SX) To (k - 1)
          SY(x) = SX(x)
        Next x
    'Get REQs
        If Len(gstrReq) > 0 Then
            ReDim Preserve SY(LBound(SY) To UBound(SY) + 1)
            SY(UBound(SY)) = gstrReq
        End If
    'Get stuff after REQs
        ReDim Preserve SY(LBound(SY) To n)
            For x = (k + j) To UBound(SX)
                SY(x) = SX(x)
            Next x
        
        'Print results:
            For x = LBound(SY) To UBound(SY)
                varComments = varComments & (SY(x) + IIf(x <> UBound(SY), vbCrLf, ""))
            Next x
            Do
                varComments = Replace(varComments, vbCrLf & vbCrLf, vbCrLf)
            Loop Until InStr(varComments, vbCrLf & vbCrLf) = 0
            'Insert result to Comments box
                Debug.Print varComments
            
            Forms!frmSR_Main!RequestorComments = varComments
    End With

ExitProc:
   Exit Function
ProcError:
   MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetCommentData_EMO of Module Functions"
   Resume ExitProc
   Resume
End Function

Open in new window

0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

  • 4
  • 4
  • 3
  • +2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now