Consulting

Results 1 to 12 of 12

Thread: VBA for Find and Replace a string of text

  1. #1
    VBAX Regular
    Joined
    Jun 2021
    Posts
    17
    Location

    Red face VBA for Find and Replace a string of text

    Hello experts-
    hoping someone can help with VBA to do find and replace a string of text on all slides, including shapes and boxes:

    I need to do this:

    Find "June 2021" replace with "July 2021"
    Find "Aug 2021" replace with "Sept 2021"
    Find "Oct 2021" replace with "Nov 2021"
    Find "Dec 2021" replace with "Jan 2022"

    thank you!

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,956
    Location
    Here's what I've been using - it covers the cases I usually have

    When something new comes up, I just expand it

    Sub drv()
    
    
        Call pvtReplaceText("zzzzzzzz", "12345678", True)
    
    
    End Sub
    
    
    'http://skp.mvps.org/ppt00025.htm#2
    Sub pvtReplaceText(sOld As String, sNew As String, Optional bWholeWord As Boolean = False)
        
        Dim oSlide As Slide
        Dim oShape As Shape
        Dim oText As TextRange
        Dim oTemp As TextRange
        
        For Each oSlide In ActivePresentation.Slides
    
    
            For Each oShape In oSlide.Shapes
                Call pvtReplaceText1(oShape, sOld, sNew, bWholeWord)
            Next oShape
        
        Next oSlide
    
    
    End Sub
    
    
    
    
    Private Sub pvtReplaceText1(oShape As Object, FindString As String, ReplaceString As String, Optional bWholeWord As Boolean = False)
        Dim oText As TextRange
        Dim oTemp As TextRange
        Dim i As Long, iRows As Long, iCols As Integer
        Dim oShapeTmp As Shape
     
        Select Case oShape.Type
        
            Case msoPlaceholder
                Call pvtText(oShape, FindString, ReplaceString, bWholeWord)
                If oShape.HasTable Then
                    Call pvtTable(oShape.Table, FindString, ReplaceString, bWholeWord)
                End If
                If oShape.HasSmartArt Then
                    Call pvtSmartArt(oShape.SmartArt, FindString, ReplaceString)
                End If
            
            Case msoTable
                Call pvtTable(oShape.Table, FindString, ReplaceString, bWholeWord)
            
            Case msoGroup    'Groups may contain shapes with text, so look within it
                For i = 1 To oShape.GroupItems.Count
                    Call pvtReplaceText1(oShape.GroupItems(i), FindString, ReplaceString)
                Next i
            
            Case msoDiagram
                Call pvtNodes(oShape.Diagram, FindString, ReplaceString)
                
            Case msoSmartArt
                Call pvtSmartArt(oShape.SmartArt, FindString, ReplaceString)
                
            Case Else
                Call pvtText(oShape, FindString, ReplaceString, bWholeWord)
            End Select
    End Sub
    
    
    
    
    Private Sub pvtTable(oTable As Table, FindString As String, ReplaceString As String, Optional bWholeWord As Boolean = False)
        Dim iRows As Long, iCols As Integer
        Dim oShapeTmp As Shape
        
        With oTable
            For iRows = 1 To .Rows.Count
                For iCols = 1 To .Rows(iRows).Cells.Count
                    Set oShapeTmp = .Rows(iRows).Cells(iCols).Shape
                    Call pvtText(oShapeTmp, FindString, ReplaceString, bWholeWord)
                Next
            Next
        End With
    End Sub
    
    
    
    
    Private Sub pvtText(oShape As Shape, FindString As String, ReplaceString As String, Optional bWholeWord As Boolean = False)
        Dim oTextRange As TextRange, oTextRangeTemp As TextRange
        Dim i As Long
    
    
        With oShape
                
            If Not .HasTextFrame Then Exit Sub
            If Not .TextFrame.HasText Then Exit Sub
                        
             Set oTextRange = .TextFrame.TextRange
             Set oTextRangeTemp = oTextRange.Replace(FindWhat:=FindString, Replacewhat:=ReplaceString, WholeWords:=bWholeWord)
             Do While Not oTextRangeTemp Is Nothing
                 Set oTextRangeTemp = oTextRange.Replace(FindWhat:=FindString, Replacewhat:=ReplaceString, WholeWords:=bWholeWord)
             Loop
         
             For i = 1 To oTextRange.Paragraphs.Count
                 Set oTextRange = oTextRange.Paragraphs(i)
                 oTextRange.Text = Trim(oTextRange.Text)
                 oTextRange.Characters(1, 1) = UCase(oTextRange.Characters(1, 1))
             Next i
        End With
    End Sub
    
    
    Private Sub pvtNodes(oDiagram As Diagram, FindString As String, ReplaceString As String)
        Dim i As Long
        
        With oDiagram
            For i = 1 To .Nodes.Count
                Call pvtText(.Nodes(i).TextShape, FindString, ReplaceString)
            Next i
        End With
    End Sub
    
    
    Private Sub pvtSmartArt(oSmartart As SmartArt, FindString As String, ReplaceString As String)
        Dim i As Long
        Dim s As String
        
        With oSmartart
            For i = 1 To .Nodes.Count
                s = .AllNodes(i).TextFrame2.TextRange.Text
                .AllNodes(i).TextFrame2.TextRange.Text = Replace(s, FindString, ReplaceString)
            Next i
        End With
    End Sub
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    VBAX Regular
    Joined
    Jun 2021
    Posts
    17
    Location
    Hi Paul!
    thank you so much!! one follow up question.
    how do I adjust the VBA to look for whole word?
    what do I need to change? thanks!!

  4. #4
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,956
    Location
    My understanding is that the .TextRange.Replace object allows a 'Whole Word' parameter, but the VBA Replace doesn't

    So in the main

    Sub pvtReplaceText(sOld As String, sNew As String, Optional bWholeWord As Boolean = False)
    the bWholeWord flag is pass to everything that can use it


    Any eamples?
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  5. #5
    VBAX Regular
    Joined
    Jun 2021
    Posts
    17
    Location
    Hi Paul - ok it is working.
    How about an OR statement. for example, Find "puppy" or "doggie" replace with "dog"?
    i expanded your original with 7 other finds but it looks like I will need to have the OR in some of them. thank you!!

  6. #6
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,956
    Location
    I'd just call pvtReplaceText () two times


    
    Sub drv()
        Call pvtReplaceText("puppy", "dog", True)
        Call pvtReplaceText("doggie", "dog", True)
    End Sub
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  7. #7
    VBAX Regular
    Joined
    Jun 2021
    Posts
    17
    Location
    Hi Paul,
    sorry to ask one more question here. after running your codes, the VBA randomly added four extra blank lines to text content of some of the slides and those slides do not have any of the text i am looking for. It is very strange. it looks random but i am sure its got to be the codes.
    Any idea?

    thank you!



    Quote Originally Posted by Paul_Hossler View Post
    I'd just call pvtReplaceText () two times


    
    Sub drv()
        Call pvtReplaceText("puppy", "dog", True)
        Call pvtReplaceText("doggie", "dog", True)
    End Sub

  8. #8
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,956
    Location
    Attach a small presentation with 2-3 slides that show it along with your macro
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  9. #9
    VBAX Regular
    Joined
    Jun 2021
    Posts
    17
    Location
    Thanks Paul. Please see attached sample slides with the Macro.

    Once I run the Find Replace macro, the macro added extra lines to the slides where there was a replacement....very strange.Test Find and Replace.pptmTest Find and Replace.pptm


    Quote Originally Posted by Paul_Hossler View Post
    Attach a small presentation with 2-3 slides that show it along with your macro

  10. #10
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,956
    Location
    Delete these lines and it should work. I can't remember why I had them in the macro, but I must have had SOME reason at the time. Might have been some special processing I needed

    '         For i = 1 To oTextRange.Paragraphs.Count
    '             Set oTextRange = oTextRange.Paragraphs(i)
    '             oTextRange.Text = Trim(oTextRange.Text)
    '             oTextRange.Characters(1, 1) = UCase(oTextRange.Characters(1, 1))
    '         Next i
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  11. #11
    VBAX Regular
    Joined
    Jun 2021
    Posts
    17
    Location
    Thanks Paul! that worked great!
    Now how do I make this macro find and replace words in the Notes? I just realized it did not pick up the matches in the Notes. Let me know what I need to add to the codes. THANK YOU!!!



    Quote Originally Posted by Paul_Hossler View Post
    Delete these lines and it should work. I can't remember why I had them in the macro, but I must have had SOME reason at the time. Might have been some special processing I needed

    '         For i = 1 To oTextRange.Paragraphs.Count
    '             Set oTextRange = oTextRange.Paragraphs(i)
    '             oTextRange.Text = Trim(oTextRange.Text)
    '             oTextRange.Characters(1, 1) = UCase(oTextRange.Characters(1, 1))
    '         Next i

  12. #12
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,956
    Location
    try the added lines

    'http://skp.mvps.org/ppt00025.htm#2
    Sub pvtReplaceText(sOld As String, sNew As String, Optional bWholeWord As Boolean = False)
        
        Dim oSlide As Slide
        Dim oShape As Shape
        Dim oText As TextRange
        Dim oTemp As TextRange
        
        For Each oSlide In ActivePresentation.Slides
    
    
            For Each oShape In oSlide.Shapes
                Call pvtReplaceText1(oShape, sOld, sNew, bWholeWord)
            Next oShape
        
            'added 6/17/2021
            If oSlide.HasNotesPage Then
                For Each oShape In oSlide.NotesPage.Shapes
                    Call pvtReplaceText1(oShape, sOld, sNew, bWholeWord)
                Next oShape
            End If
        Next oSlide
    
    
    End Sub
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •