# Vba code to replace with chr(13) with space for selected text in powerpoint



## shoun2502 (Aug 18, 2019)

Dear all, 

I am currently working on this code and *I need to replace chr(13) with space for the selected text and not for the whole slide*. The code below works well with all shapes in active presentation . 

The code is as follows :




```
Sub Removepb()
Dim otxR As TextRange
Dim osld As Slide
Dim oshp As Shape
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If Not oshp.Type = msoPlaceholder Then
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText Then
Set otxR = oshp.TextFrame.TextRange
otxR.Text = Replace(otxR.Text, Chr(13), "")
End If
End If
End If
Next oshp
Next osld
End Sub
```

The suggestions  would be welcome to customize this subroutine to run on the selected Text inside a shape. 

Regards


----------



## Yongle (Aug 20, 2019)

Select a shape containing text and run the code


```
Sub ReplaceText()
    Dim Shp As Shape
    On Error Resume Next
    For Each Shp In ActiveWindow.Selection.ShapeRange
        If Shp.HasTextFrame Then
            With Shp.TextFrame.TextRange
                .Text = Replace(.Text, Chr(10), "") 
            End With
            Exit For
        End If
    Next Shp
    If Err.Number > 0 Then MsgBox "no shape selected"
End Sub
```


Notes
*.Text = Replace(.Text, Chr(10), "")* 
- your original code which you said does exactly what you want
*
On Error Resume Next* 
- prevents the code failing if run when nothing selected


----------



## shoun2502 (Aug 20, 2019)

Hi Yongle,

The code is not working 

Thanks for the reply.


----------



## shoun2502 (Aug 20, 2019)

Hi yongle, 

I have used your subroutine with slight modificactions as mentioned below


```
Sub ReplaceText()
    Dim Shp As Shape
    On Error Resume Next
    For Each Shp In ActiveWindow.Selection.ShapeRange
        If Shp.HasTextFrame Then
            With Shp.TextFrame.TextRange
                .Text = Replace(.Text, Chr(13), "")
            End With
            Exit For
        End If
    Next Shp
    If Err.Number > 0 Then MsgBox "no shape selected"
End Sub
```

But the issue it is replacing all text in the shape rather *than the  selected text.

Please help if you could check that. 


*Thanks for your reply


----------



## Yongle (Aug 21, 2019)

Here you go
- select a single block of text within a shape and run the code


```
Sub ReplaceSelectedText()
    Dim Shp As Shape, Pos As Long, LenSelTxt As Long, lenShpTxt As Long
    Dim SelTxt As String, shpTxt As String, leftTxt As String, rightTxt As String
    
    On Error Resume Next
    For Each Shp In ActiveWindow.Selection.ShapeRange
[COLOR=#006400][I]    'selected text[/I][/COLOR]
        SelTxt = ActiveWindow.Selection.TextRange
        LenSelTxt = Len(SelTxt)
[I][COLOR=#006400]    'shape text[/COLOR][/I]
        shpTxt = Shp.TextFrame.TextRange.Text
        lenShpTxt = Len(shpTxt)
 [COLOR=#006400][I]   'to left and right of selected text[/I][/COLOR]
        Pos = InStr(1, shpTxt, SelTxt, vbTextCompare)
        leftTxt = Left(shpTxt, Pos - 1)
        rightTxt = Right(shpTxt, lenShpTxt - Pos - LenSelTxt + 1)
 [I][COLOR=#006400]   'replace text and reassemble[/COLOR][/I]
        SelTxt = Replace(SelTxt, Chr(10), " ")
        shpTxt = leftTxt & SelTxt & rightTxt
        Shp.TextFrame.TextRange.Text = shpTxt
        Exit For
    Next Shp
End Sub
```


----------



## shoun2502 (Aug 21, 2019)

Thanks Yongle

Saved a lot of time indeed!


----------



## Yongle (Aug 21, 2019)

Thanks for the feedback


----------

