0

This code is to find and replace a list of text for quality check

sub FindAndReplace()
 Dim Pres As Presentation
 Dim sld As Slide
 Dim shp As Shape

 For Each Pres In Application.Presentations
      For Each sld In Pres.Slides
         For Each shp In sld.Shapes
             Call checklist(shp)
         Next shp
     Next sld
 Next Pres
 MsgBox "Completed Succesfully!"
 End Sub

Sub checklist(shp As Object)

    Dim txtRng As TextRange
    Dim rngFound As TextRange
    Dim I, K, X As Long
    Dim iRows As Integer
    Dim iCols As Integer
    Dim TargetList, DestinationList

    TargetList = Array("        ", "       ", "      ", "     ", "    ", "   ", "  ", " / ", "i.e. ", "e.g. ", "/ ", " /", " :", " ;", " .", " ,", " - ", "resume", "a.m.", "p.m.", ":00")
    DestinationList = Array(" ", " ", " ", " ", " ", " ", " ", "/", "i.e., ", "e.g., ", "/", "/", ":", ";", ".", ",", " – ", "résumé", "am", "")


       With shp

       If shp.HasTable Then
       For iRows = 1 To shp.Table.Rows.Count
                    For iCols = 1 To shp.Table.Rows(iRows).Cells.Count
                        Set txtRng = shp.Table.Rows(iRows).Cells(iCols).Shape.TextFrame.TextRange
                               For I = 0 To UBound(TargetList)
                               Set rngFound = txtRng.Replace(TargetList(I), DestinationList(I))
                               Do While Not rngFound Is Nothing
                               Set rngFound = txtRng.Replace(TargetList(I), DestinationList(I), After:=rngFound.Start + rngFound.Length, wholewords:=True)
                               Loop
                               Next
                        Next
                Next
       End If

     End With


           Select Case shp.Type


            Case msoGroup
                For X = 1 To shp.GroupItems.Count
                    Call checklist(shp.GroupItems(X))
                Next X

            Case 21
                For X = 1 To shp.Diagram.Nodes.Count
                    Call checklist(shp.GroupItems(X))
                Next X

            Case Else

                 If shp.HasTextFrame Then
                           If shp.TextFrame.HasText Then
                               Set txtRng = shp.TextFrame.TextRange
                               For I = 0 To UBound(TargetList)
                               Set rngFound = txtRng.Replace(TargetList(I), DestinationList(I))
                               Do While Not rngFound Is Nothing
                               Set rngFound = txtRng.Replace(TargetList(I), DestinationList(I), After:=rngFound.Start + rngFound.Length, wholewords:=True)
                               Loop
                               Next
                           End If
                       End If

            End Select


End Sub

I am getting run time 9 error for this code.

Also this code is replacing only the first occurrence of the certain words like "i.e." and "e.g:, but I want to replace all the occurrences.

halfer
  • 19,824
  • 17
  • 99
  • 186
Pandi Muthu
  • 29
  • 1
  • 6

1 Answers1

0

The reason for the error is that you are trying to reference item 21 in the DestinationList array and it doesn't exist because you are missing a corresponding argument for "p.m." I added error checking for that, corrected the Dim line for I, K, X and change 0 to LBound when looping the arrays because if the base is not 0, that will cause issues too. Corrected code:

Option Explicit

Private ArrayError As Boolean

Sub FindAndReplace()
 Dim Pres As Presentation
 Dim sld As Slide
 Dim shp As Shape

 ArrayError = False
 For Each Pres In Application.Presentations
      For Each sld In Pres.Slides
         For Each shp In sld.Shapes
             If Not ArrayError Then checklist shp
         Next shp
     Next sld
 Next Pres
 If Not ArrayError Then MsgBox "Completed Succesfully!"
 End Sub

Sub checklist(shp As Object)

    Dim txtRng As TextRange
    Dim rngFound As TextRange
    Dim I As Long, K As Long, X As Long
    Dim iRows As Integer
    Dim iCols As Integer
    Dim TargetList, DestinationList

    TargetList = Array("        ", "       ", "      ", "     ", "    ", "   ", "  ", " / ", "i.e. ", "e.g. ", "/ ", " /", " :", " ;", " .", " ,", " - ", "resume", "a.m.", "p.m.", ":00")
    DestinationList = Array(" ", " ", " ", " ", " ", " ", " ", "/", "i.e., ", "e.g., ", "/", "/", ":", ";", ".", ",", " ? ", "résumé", "am", "pm", "")

    If Not UBound(TargetList) = UBound(DestinationList) Then
      MsgBox "Search and Replace arrary do not have the same number of arguments.", vbCritical + vbOKOnly, "Arrays Don't Match"
      ArrayError = True
      Exit Sub
    End If

       With shp

       If shp.HasTable Then
       For iRows = 1 To shp.Table.Rows.Count
                    For iCols = 1 To shp.Table.Rows(iRows).Cells.Count
                        Set txtRng = shp.Table.Rows(iRows).Cells(iCols).Shape.TextFrame.TextRange
                               For I = LBound(TargetList) To UBound(TargetList)
                               Set rngFound = txtRng.Replace(TargetList(I), DestinationList(I))
                               Do While Not rngFound Is Nothing
                               Set rngFound = txtRng.Replace(TargetList(I), DestinationList(I), After:=rngFound.Start + rngFound.Length, wholewords:=True)
                               Loop
                               Next
                        Next
                Next
       End If

     End With


           Select Case shp.Type


            Case msoGroup
                For X = 1 To shp.GroupItems.Count
                    Call checklist(shp.GroupItems(X))
                Next X

            Case 21
                For X = 1 To shp.Diagram.Nodes.Count
                    Call checklist(shp.GroupItems(X))
                Next X

            Case Else

                 If shp.HasTextFrame Then
                           If shp.TextFrame.HasText Then
                               Set txtRng = shp.TextFrame.TextRange
                               For I = LBound(TargetList) To UBound(TargetList)
                               Set rngFound = txtRng.Replace(TargetList(I), DestinationList(I))
                               Do While Not rngFound Is Nothing
                               Set rngFound = txtRng.Replace(TargetList(I), DestinationList(I), After:=rngFound.Start + rngFound.Length, wholewords:=True)
                               Loop
                               Next
                           End If
                       End If

            End Select


End Sub
Jamie Garroch - MVP
  • 2,839
  • 2
  • 16
  • 24
  • But i still i couldn't understand the root cause for the error. I am facing the same error for the below code too, But it worked fine initially. But later when i collaborate all the modules to create add-in. Its showing the same error as above. "Run time error 9" – Pandi Muthu Dec 21 '15 at 10:14
  • The root cause of the error is that you had 21 arguments in the TargetList array and 20 in the DestinationList so when you used the UBound of the TargetList array in your loop and it reached the 21st argument, it failed to find a corresponding 21st item in the DestinationList array. – Jamie Garroch - MVP Dec 22 '15 at 19:18