View Single Post
 
Old 12-12-2014, 06:43 PM
ptmuldoon ptmuldoon is offline Windows 7 64bit Office 2013
Advanced Beginner
 
Join Date: Sep 2014
Posts: 93
ptmuldoon is on a distinguished road
Default Searching Arrays without Loops?

I was able to put the below together, and it seems to work ok, but I think this could be more efficient with an array match of some sort. And still trying to learn more on that.

I would think maybe I could take an array of NamedRanges from Excel. And a 2nd Array of BookMarks from Word. Then compare/match the 2 arrays, placing the Matches into a new, third array, and then update my Word BookMarks with the values of the named ranges?

But I think i'm trying compare a 1 dimensional (bookmarks) to a 2 dimensional (NamedRange Name and Values)?

This code currently works. But can it be more efficient?
Code:
Sub Test()
    Dim f, xlWorkBook, NmdValue As Object
    Dim Bm, Nm As Variant
    Dim Bmk, NmdRng As String

    'Choose the Excel File
    Set f = Application.FileDialog(msoFileDialogFilePicker)
    f.Title = "Please Select A New File"
    f.AllowMultiSelect = False
    f.Filters.Clear
    f.Filters.Add "Microsoft Excel Files", "*.xls, *.xlsb, *.xlsm, *.xlsx" 'Limit to Excel Files Only

    If f.Show = -1 Then
        Set xlWorkBook = GetObject(f.SelectedItems(1))
    Else 'user clicked cancel
        Exit Sub
    End If
          
    For Each Bm In ActiveDocument.Bookmarks
        Bmk = Bm.Name
             
        ' Check Each BookMark for a Matching NamedRanged in the Excel File
        For Each Nm In xlWorkBook.Names
        NmdRng = Nm.Name
        Set NmdValue = xlWorkBook.Names(NmdRng).RefersToRange
        
             If Bmk = NmdRng Then
                ActiveDocument.Bookmarks(Bmk).Range.InsertAfter NmdValue
                'UpdateBM Bmk, NmdValue
                 Exit For
             End If
        Next Nm
        
    Next Bm
    
    ActiveDocument.Bookmarks.ShowHidden = True
    ActiveWindow.View.ShowBookmarks = False
    
End Sub


Sub UpdateBM(BookmarkToUpdate As String, TextToUse As String)
    Dim BMRange As Range
    Set BMRange = ActiveDocument.Bookmarks(BookmarkToUpdate).Range
    BMRange.Text = TextToUse
    ActiveDocument.Bookmarks.Add BookmarkToUpdate, BMRange
End Sub
Reply With Quote