Consulting

Results 1 to 6 of 6

Thread: Word VBA - Search and Replace in Specific Ranges - Multidimensional Array

  1. #1
    VBAX Mentor
    Joined
    Feb 2016
    Location
    I have lived in many places, I love to Travel
    Posts
    413
    Location

    Word VBA - Search and Replace in Specific Ranges - Multidimensional Array

    Good day folks,





    I am doing search and replacement between sets of ranges that I have put between 2 placeholders.

    I have put them in an array.

    Each set has a different search and replacement to happen.

    The problem is it is replacing the same for both sets.






     Sub CSET_Forum()
        
    
        Dim oRng As Range
        Dim oRng2 As Range
        Dim lngIndex As Long
        Dim k As Variant
        Dim Array_Terms             'dimmed as variant
        
    
        'Array Terms
        'Place holder 1      =  Term[0]
        'Placeholder  2      =  Term[1]
        'Search              =  Term[2]
        'Replace             =  Term[3]
        '---------------------------------------------------------------------
        
       
    
       
        Array_Terms = Array(Array("[A1]", "[A2]", "Apple", "11111"), Array("[B3]", "[B4]", "Apple", "22222"))
        
         
        
        k = 0
        For lngIndex = LBound(Array_Terms) To UBound(Array_Terms)
        
        
        Set oRng = ActiveDocument.Range
        With oRng.Find
        
        'Find the Ranges between the 2 Placeholders
        Do While .Execute(FindText:=Array_Terms(k)(0) & "*" & Array_Terms(k)(1), MatchWildcards:=True)
        
        
        
        '------------------------------------------
        ' Each Range  - Do the Search and Replacements
        Set oRng2 = oRng
        With oRng2.Find
        
        'Search and Replace
        Do While .Execute(FindText:=Array_Terms(k)(2), MatchWholeWord:=True)
        
        oRng2.Text = Array_Terms(k)(3)
        
        
        '.Wrap = wdFindStop
        
        oRng2.Collapse 0
        
    
        Loop
        End With
        Set oRng2 = Nothing
        '------------------------------------------
    
    
       
        Loop
        End With
        k = k + 1
        Next lngIndex
    
    lbl_Exit:
        Exit Sub
    End Sub





    I know I may not have set my ranges correctly and my loop may be not correct. I added an inner loop but that still didn’t work.

    Please do help and advise

    Thank you for you time.
    Cheers for your help

    dj

    'Extreme VBA Newbie in progress - one step at a time - like a tortoise's pace'


  2. #2
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    An example of what you are trying to find and replace with what would be helpful.
    Greg

    Visit my website: http://gregmaxey.com

  3. #3
    VBAX Mentor
    Joined
    Feb 2016
    Location
    I have lived in many places, I love to Travel
    Posts
    413
    Location
    Hello Greg,

    nice to see you.

    Example
    Array for [A1] to [A2] find Apple replace with 11111

    I put the terms in its own specific array.
    Array("[A1]", "[A2]", "Apple", "11111")


    __________________________________________________________
    Before

    You can also type a keyword to search online for the video that best fits your document.
    [A1]
    Apple
    Apricot
    Avocado
    [A2]
    You can also type a keyword to search online for the video that best fits your document.
    [B3]
    Apricot
    Apple
    Avocado
    [B4]
    Hello text
    __________________________________________________________

    After
    You can also type a keyword to search online for the video that best fits your document.
    [A1]
    11111
    Apricot
    Avocado
    [A2]
    You can also type a keyword to search online for the video that best fits your document.
    [B3]
    Apricot
    2222
    Avocado
    [B4]
    Hello text
    __________________________________________________________

    I wanted to search and replace different sets of words between each range.
    Last edited by dj44; 04-08-2020 at 07:27 AM. Reason: spelling
    Cheers for your help

    dj

    'Extreme VBA Newbie in progress - one step at a time - like a tortoise's pace'


  4. #4
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    Couple of things, [ and ] are special wildcard characters so you have to escape them with \. You have to handle the find runaway range.

    Sub CSET_Forum()
    Dim oRng As Range
    Dim oRng2 As Range
    Dim lngIndex As Long
    Dim k As Variant
    Dim Array_Terms
      
      Array_Terms = Array(Array("\[A1\]", "\[A2\]", "Apple", "11111"), Array("\[B3\]", "\[B4\]", "Apple", "22222"))
      k = 0
      For lngIndex = LBound(Array_Terms) To UBound(Array_Terms)
        Set oRng = ActiveDocument.Range
        With oRng.Find
          'Find the Ranges between the 2 Placeholders
          Do While .Execute(FindText:=Array_Terms(k)(0) & "*" & Array_Terms(k)(1), MatchWildcards:=True)
            Set oRng2 = oRng.Duplicate
            With oRng2.Find
              'Search and Replace
              Do While .Execute(FindText:=Array_Terms(k)(2), MatchWholeWord:=True)
                If oRng2.InRange(oRng) Then
                  oRng2.Text = Array_Terms(k)(3)
                  oRng2.Collapse 0
                Else
                  Exit Do
                End If
              Loop
            End With
            Set oRng2 = Nothing
          Loop
        End With
        k = k + 1
      Next lngIndex
    lbl_Exit:
      Exit Sub
    End Sub
    Greg

    Visit my website: http://gregmaxey.com

  5. #5
    VBAX Mentor
    Joined
    Feb 2016
    Location
    I have lived in many places, I love to Travel
    Posts
    413
    Location
    Hello Greg,


    I havent touched vba in a while as things have been running nicely, with all the great code i have from here.

    Well the moment i tried to code again my arrays crashed my computer as there was a type mismatch happening somewhere.

    Any way i tried an alternate cset version of moving the ranges but it wouldnt find the ranges.

    Thank you for solving this problem so quickly, and alerting me about the bracket issue.


    I hope you are keeping well and the greatest of thanks for solving this problem.

    It does the JOB AMAZINGLY - Search and replace but only within the range I set and different words for each range.




    have a great day!
    Cheers for your help

    dj

    'Extreme VBA Newbie in progress - one step at a time - like a tortoise's pace'


  6. #6
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    Greg

    Visit my website: http://gregmaxey.com

Posting Permissions

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