Problem with OR condition

[Rathish]

Hi,
I am trying to create a macro which will search for space before comma and space before full stop (period).
If i check one condition at a time like , only it works perfectly fine. However when i apply or condition it does not work properly.

"If crn_txt <> "," Or crn_txt <> "." Then

If crn_txt = "," Or crn_txt <> "," And old_text = " " Then"


Given below is the code that i have prepared for reference. Checking one by one in loop like .(period) then comma it is taking lots of time.

Please help it is very important for me.



Sub spc_bfr_comma()
fnt_nme = False
fnt_clr = False
Dim oSld As Slide
Dim now_end As Boolean
Dim x As Long
Dim m As Double
Dim R As Double

shape_cont = 1
err_num = 0
now_end = False
slide_num = 1
m = 0
fnt_clr_chck = False

For Each oSld In ActivePresentation.Slides
With Application.ActiveWindow
ViewType = ppViewNormal
On Error Resume Next
.View.GotoSlide slide_num
End With
For Each oShp In oSld.Shapes
If oShp.HasTextFrame Then
If oShp.TextFrame.HasText Then
With oShp.TextFrame.TextRange
'For x = .Runs.Count To 1 Step -1
Text = .Runs(x).Text
On Error Resume Next
ActiveWindow.Selection.SlideRange.Shapes(shape_cont).Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
whole_text = ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Text
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Words
whole_text_len = Len(whole_text)
'crn_txt = ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=x). Characters
cnrvsn_text_dbl = CDbl(whole_text_len)
end_loop = cnrvsn_text_dbl
For k = 1 To end_loop

crn_txt = ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(start:=k). Characters
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(start:=k). Select
If crn_txt <> "," Or crn_txt <> "." Then
old_text = Empty
End If
If crn_txt = "," Or crn_txt <> "," And old_text = " " Then
d = k - 1
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(start:=d). Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(start:=d). Cut
k = k - 5
'If k > end_loop Then
'shape_cont = shape_cont + 1
'GoTo a:
'Exit Sub
'End If

'MsgBox "Error"
old_text = Empty
crn_txt = Null

End If

If crn_txt = " " Then
old_text = crn_txt
End If

Next k


'Next x
End With
End If 'has text
End If 'has textframe
a:
shape_cont = shape_cont + 1
Next oShp
slide_num = slide_num + 1
shape_cont = 1
Next oSld
slide_num = 1
'period_chk
'MsgBox "SPACE BEFORE comma DONE"
'UserForm1.Visible = False
End Sub


Regards
Rathish

[John Wilson]

Does this run faster?

Sub spacecomma() 
    Dim osld As Slide 
    Dim oshp As Shape 
    For Each osld In ActivePresentation.Slides 
        For Each oshp In osld.Shapes 
            If oshp.HasTextFrame Then 
                If oshp.TextFrame.HasText Then 
                    Call replaceme(oshp, " ,", ",") 
                    Call replaceme(oshp, " .", ".") 
                End If 
            End If 
        Next oshp 
    Next osld 
End Sub 
Sub replaceme(oshp As Object, ReplaceThis As String, ReplaceWith As String) 
    Dim oTxtR As TextRange 
    Dim oTmpR As TextRange 
    Set oTxtR = oshp.TextFrame.TextRange 
    Set oTmpR = oTxtR.Replace(FindWhat:=ReplaceThis, _ 
    Replacewhat:=ReplaceWith, WholeWords:=False) 
    Do While Not oTmpR Is Nothing 
        Set oTmpR = oTxtR.Replace(FindWhat:=ReplaceThis, _ 
        Replacewhat:=ReplaceWith, _ 
        After:=oTmpR.Start + oTmpR.Length, _ 
        WholeWords:=False) 
    Loop 
     
End Sub 

VBA tags courtesy of www.thecodenet.com

[Rathish]

Thank for a quick reply. However code stucks on the given below part:

Do While Not oTmpR Is Nothing
Set oTmpR = oTxtR.Replace(FindWhat:=ReplaceThis, _
Replacewhat:=ReplaceWith, _
After:=oTmpR.Start + oTmpR.Length, _
WholeWords:=False)
Loop
Thanks a lot for the help....

Regards
Radish

[John Wilson]

I can't see any problem with the code.
Did you copy paste it?
What version of PowerPoint?
Do you get an error message or are you saying the loop doesn't terminate.

[Rathish]

Thank you very much for the help......

[Rathish]

Hi,
Your code drastically changed the timings it is like a magic. within 2 minutes it is checking almost 20 slides. Thanks.

Just wanted to check if i want do the change as per user input for e.g.

>>If i get "&" sign i want to replace with and.

>>A userform will appear (have got the user form).

>>Based on the user's input "change" or "No change" it work.

In the code that you provided. After getting the changing option; if changing option is equal to "&" then call the userform. I tried doing it but messed up.

The reason for giving this option is in company names sometimes we have to retain & sign as it is and in the flowing text we have to change to and.

[John Wilson]

Not trivial to do that properly. If you want an addIn written to do it properly we will happily quote you. It won't be very expensive and will save you hours.
john AT pptalchemy.co.uk

[Rathish]

Thanks John Really appreciate your help. However my boss will not pay me for this. Will get back to you once i discuss.

[John Wilson]

Bosses are like that, can'yt see the wasted time!

For a quick 'dirty' fix try

Sub spacecomma() 
    Dim osld As Slide 
    Dim oshp As Shape 
    For Each osld In ActivePresentation.Slides 
        For Each oshp In osld.Shapes 
            If oshp.HasTextFrame Then 
                If oshp.TextFrame.HasText Then 
                    Call replaceme(oshp, " ,", ",") 
                    Call replaceme(oshp, " .", ".") 
                    If InStr(oshp.TextFrame.TextRange, "&") > 0 Then 
                        ActiveWindow.View.GotoSlide (osld.SlideIndex) 
                        If MsgBox(oshp.TextFrame.TextRange & vbCrLf & _ 
                        "REPLACE '&' with 'and?'", vbYesNo) = vbYes Then Call replaceme(oshp, "&", "and") 
                    End If 
                End If 
            End If 
        Next oshp 
    Next osld 
End Sub 
Sub replaceme(oshp As Object, ReplaceThis As String, ReplaceWith As String) 
    Dim oTxtR As TextRange 
    Dim oTmpR As TextRange 
    Set oTxtR = oshp.TextFrame.TextRange 
    Set oTmpR = oTxtR.Replace(FindWhat:=ReplaceThis, _ 
    Replacewhat:=ReplaceWith, WholeWords:=False) 
    Do While Not oTmpR Is Nothing 
        Set oTmpR = oTxtR.Replace(FindWhat:=ReplaceThis, _ 
        Replacewhat:=ReplaceWith, _ 
        After:=oTmpR.Start + oTmpR.Length, _ 
        WholeWords:=False) 
    Loop 
     
End Sub 

VBA tags courtesy of www.thecodenet.com

[Rathish]

Thanks a ton.
For not only giving me the option but making me learn a new thing..... Today...

[Rathish]

Hi Got an issue in the code.
This doesn't check anything in the table. Please help me....

[Rathish]

Hey John,
I tried to fix the issue; given below is the code.
Can you please have a look if i haven't done any blunder mistake.

Thanks
Rathish

Sub spacecomma()
Dim osld As Slide
Dim oshp As Shape
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText Then
Call replaceme(oshp, " ,", ",", txt_fld, iRow, iColumn)
Call replaceme(oshp, " .", ".", txt_fld, iRow, iColumn)
End If
End If

If oshp.HasTable Then
oshp.Select

With ActiveWindow.Selection.ShapeRange.Table

rcont = .Rows.Count
clcnt = .Columns.Count
For iRow = 1 To rcont

For iColumn = 1 To clcnt
If .Cell(iRow, iColumn).Shape.TextFrame.HasText Then
txt_fld = .Cell(iRow, iColumn).Shape.TextFrame.TextRange
Call replaceme(oshp, " ,", ",", txt_fld, iRow, iColumn)
Call replaceme(oshp, " .", ".", txt_fld, iRow, iColumn)
End If
Next iColumn
Next iRow
End With
End If

Next oshp
Next osld
End Sub
Sub replaceme(oshp As Object, ReplaceThis As String, ReplaceWith As String, txt_fld_1, iRow, iColumn)
Dim oTxtR As TextRange
Dim oTmpR As TextRange
'Set oTxtR = oshp.TextFrame.TextRange
'Set oTxtR = oshp.TextFrame.TextRange
Set oTxtR = ActiveWindow.Selection.ShapeRange.Table.Cell(iRow, iColumn).Shape.TextFrame.TextRange
Set oTmpR = oTxtR.Replace(FindWhat:=ReplaceThis, _
Replacewhat:=ReplaceWith, WholeWords:=False)
Do While Not oTmpR Is Nothing
Set oTmpR = oTxtR.Replace(FindWhat:=ReplaceThis, _
Replacewhat:=ReplaceWith, _
After:=oTmpR.Start + oTmpR.Length, _
WholeWords:=False)
Loop

End Sub

[John Wilson]

I would have a different search replace routine called for tables.

have a look at shyam's page here

[Rathish]

one question in your code.
Condition is
Lets say we have 2 "&" in a text box; now for the first "&" i clicked cancel what the code is actually doing is it move to next text box rather than searching the second "&" in the same text box.

I got only this problem left with me. Please help....

[Rathish]

one question in your code.
Condition is
Lets say we have 2 "&" in a text box; now for the first "&" i clicked cancel what the code is actually doing is it move to next text box rather than searching the second "&" in the same text box.

I got only this problem left with me. Please help....

[John Wilson]

You would need to do something like this:

NOTE This is top of head code and may need a little work!

Sub spacecomma() 
    Dim osld As Slide 
    Dim oshp As Shape 
    Dim otempR As TextRange 
    Dim newStart As Long 
    For Each osld In ActivePresentation.Slides 
        For Each oshp In osld.Shapes 
            newStart = 1 
            If oshp.HasTextFrame Then 
                If oshp.TextFrame.HasText Then 
                    Call replaceme(oshp, " ,", ",") 
                    Call replaceme(oshp, " .", ".") 
                     
                    Set otempR = oshp.TextFrame.TextRange 
                    Do While InStr(otempR.Text, "&") > 0 
                        newStart = InStr(otempR.Text, "&") + 1 
                        ActiveWindow.View.GotoSlide (osld.SlideIndex) 
                        If MsgBox("'" & otempR & "'" & vbCrLf & vbCrLf & _ 
                        "REPLACE first '&' with 'and?'", vbYesNo) = vbYes Then 
                            otempR.Replace "&", "and" 
                            Set otempR = otempR.Characters(newStart - 2, Len(oshp.TextFrame.TextRange)) 
                        Else 
                            Set otempR = otempR.Characters(newStart, Len(oshp.TextFrame.TextRange)) 
                        End If 
                         
                    Loop 
                End If 
            End If 
        Next oshp 
    Next osld 
End Sub 
Sub replaceme(oshp As Object, ReplaceThis As String, ReplaceWith As String) 
    Dim otxtR As TextRange 
    Dim oTmpR As TextRange 
    Set otxtR = oshp.TextFrame.TextRange 
    Set oTmpR = otxtR.Replace(FindWhat:=ReplaceThis, _ 
    Replacewhat:=ReplaceWith, WholeWords:=False) 
    Do While Not oTmpR Is Nothing 
        Set oTmpR = otxtR.Replace(FindWhat:=ReplaceThis, _ 
        Replacewhat:=ReplaceWith, _ 
        After:=oTmpR.Start + oTmpR.Length, _ 
        WholeWords:=False) 
    Loop 
     
End Sub 

VBA tags courtesy of www.thecodenet.com

[Rathish]

Hi,
Sorry It didn't worked. Concept is right however it is replacing the first "&".
Condition is: Ra & Tez &
in this when code gets first "&" after Ra i cancelled.
then it searched for "&" in rest of the text.
however when i say yes to second "&" the first one is getting changed.

Please help....

[John Wilson]

I told you it was "top of head" and you may need to play with it BUT it doesn't do that for me

See http://screencast.com/t/hHhfHj8jj