Microsoft Office Forums - View Single Post - first character NOT Alpha numeric or Tilde (~) delete.

ksridh · 03-15-2014, 04:54 AM

Thanks. Paul.

These are the ones I want to achieve:
1. I want to first join all lines that start with an alphabet or Tilde (~) to their previous lines.
2. Remove the first character and its joining spaces in each line if the character is not alphanumeric or Tilde (~) - You have given the code for this but it leaves the first line and does the changes for all remaining lines.

The code I am trying for 1st point which I got from the net is:
--------------------------------------------------------------------

Code:

Sub LoopingText() 
     'Will move to the end of each line in the document and move the text to match
     'Declare variables
    Dim outputStr As String 
    Dim currLine As String 
    Dim endChar As String 
    Dim numOfLines As Integer 
    Dim ascVal As Integer 
     'Count the number of non blank lines in current document
    numOfLines = ActiveDocument.BuiltInDocumentProperties("NUMBER OF LINES") 
     'Move to start of document
    Selection.HomeKey Unit:=wdStory 
     'Start the loop - looping once for each line
    For x1 = 1 To numOfLines 
         'MsgBox (x1)
         'ascVal = (Asc(doc.Sentences(x1).Characters(1).Text))
        ascVal = (Asc(ActiveDocument.Sentences(x1).Characters(1).Te xt)) 
         'Move to start of line
        Selection.HomeKey Unit:=wdLine 
         'Select entire line and copy into variable currLine
        Selection.EndKey Unit:=wdLine, Extend:=wdExtend 
        currLine = Selection.Range.Text 
         'Remove final character (line break) from currLine
        currLine = Left(currLine, (Len(currLine) - 1)) 
         'Check to see if character currently on end of outputStr is " " (space)
        endChar = Right(outputStr, 1) 
        If x1 = 1 Then 
             'Add the current line to the variable outputStr
             'Since this is the first run through, don't add a space
            outputStr = outputStr & currLine 
            Selection.MoveDown Unit:=wdLine, Count:=1 
            Selection.HomeKey Unit:=wdLine 
        Else 
            If Not (endChar = " ") And (((ascVal >= 65 And ascVal <= 90) Or (ascVal >= 97 And ascVal <= 122) Or (ascVal >= 48 And ascVal <= 57) Or (ascVal = 126))) Then 
                 
                 'If preceding line does not have a space at the end
                 'Add current line to the variable outputStr
                outputStr = outputStr & " " & currLine 
                Selection.EndKey Unit:=wdLine 
                Selection.TypeParagraph 
                Selection.MoveDown Unit:=wdLine, Count:=1 
                Selection.HomeKey Unit:=wdLine 
            Else 
                Selection.MoveDown Unit:=wdLine, Count:=1 
                Selection.HomeKey Unit:=wdLine 
            End If 
        End If 
         
         'Move down one line
        Selection.MoveDown Unit:=wdLine, Count:=1 
         
         'Move to the next part of the loop
    Next x1 
     'Finally 'paste' outputStr onto the document
    ActiveDocument.Range = outputStr 
    ActiveDocument.Save 
End Sub

--------------------------------------------------------------------
This code just joins all lines together irrespective of my conditions.

Please help....Thanks....Karthik....