Strip out extra vbcrlf from middle of comments field.

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

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 :)

Good catch!

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

@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

Select allOpen in new window

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

Select allOpen in new window

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.

You can replace the CRs with a space, rather than just removing them, if you wish.

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

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

Thanks for the great Assist.  A combination of  aikimark and mbzip code made the difference.

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

Select allOpen in new window