Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 12-12-2014, 06:43 PM
ptmuldoon ptmuldoon is offline Searching Arrays without Loops? Windows 7 64bit Searching Arrays without Loops? Office 2013
Advanced Beginner
Searching Arrays without Loops?
 
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
  #2  
Old 12-12-2014, 06:55 PM
ptmuldoon ptmuldoon is offline Searching Arrays without Loops? Windows 7 64bit Searching Arrays without Loops? Office 2013
Advanced Beginner
Searching Arrays without Loops?
 
Join Date: Sep 2014
Posts: 93
ptmuldoon is on a distinguished road
Default

And in continuing with the above, I have started in working to compare the 2 arrays and match. But again, I think my issue that I need the array of NamedRanges from Excel needs to be a 2 dimensional to someone pass the value of the cell vs its Name?

Currently, the arrays get matched and then returns the name of the bookmark/named range, when I trying to get the value of the namedranged.

The functions Array_UIntersect and IsInArray I did find elsewhere on the web, so can not take any credit for that work. Thanks to the those authors in helping me get this far.

Code:
Sub Test()
    Dim f, xlWorkBook  As Object
    Dim Bm, Nm, NmdValue, NmdRng, Bmk, MatchNames, Match As Variant
    Dim NewPath, MyText, ShtName, Test As String
    Dim i As Integer
    
    '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
        NewPath = f.SelectedItems(1)
        Set xlWorkBook = GetObject(f.SelectedItems(1))
    Else 'user clicked cancel
        Exit Sub
    End If

    'Create the Array of NamedRanges of Chosen File
    i = 1
    ReDim NmdRng(1 To 1)
    For Each Nm In xlWorkBook.Names
        Set NmdValue = xlWorkBook.Names(Nm.Name).RefersToRange
        ReDim Preserve NmdRng(i)
        NmdRng(i) = Nm.Name
        i = i + 1
    Next Nm
            
    'Create the Array of BookMarks
    i = 1
    ReDim Bmk(1 To 1)
    For Each Bm In ActiveDocument.Bookmarks
        ReDim Preserve Bmk(i)
        Bmk(i) = Bm.Name
        i = i + 1
    Next Bm
    
    'Create a New Array of Matched Values only
    MatchNames = Array_UIntersect(NmdRng, Bmk)
 
    ' Do Something with the Matches
    If UBound(MatchNames) > 0 Then
       For Each Match In MatchNames
            If Not IsEmpty(Match) Then
                MsgBox "Match was Found with: " & Match
                ActiveDocument.Bookmarks(Match).Range.InsertAfter Match
            End If
       Next Match
    End If
        
    ActiveDocument.Bookmarks.ShowHidden = True
    ActiveWindow.View.ShowBookmarks = False
    
End Sub

Function Array_UIntersect(array1 As Variant, array2 As Variant) As Variant
  Dim tempArray As Variant
  Dim i As Long
 
  ' start with a single element
  ReDim tempArray(0)
 
  ' if element in first array exists in second array, keep it
  For i = LBound(array1) To UBound(array1)
    If IsInArray(array2, array1(i)) Then  ' found!
      ReDim Preserve tempArray(UBound(tempArray) + 1)
      tempArray(UBound(tempArray)) = array1(i)
    End If
  Next i
 
  ' first element is Empty, so shift all elements one position up
  For i = LBound(tempArray) To UBound(tempArray) - 1
      tempArray(i) = tempArray(i + 1)
  Next i
  ' remove last element
  If UBound(tempArray) <> 0 Then
    ReDim Preserve tempArray(LBound(tempArray) To UBound(tempArray) - 1)
  End If
 
  Array_UIntersect = tempArray
End Function

Function IsInArray(arr As Variant, valueToCheck As Variant) As Boolean
   IsInArray = (UBound(Filter(arr, valueToCheck)) > -1)
End Function
Reply With Quote
  #3  
Old 12-12-2014, 07:07 PM
macropod's Avatar
macropod macropod is offline Searching Arrays without Loops? Windows 7 64bit Searching Arrays without Loops? Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Perhaps:
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
             
    ' Check Each NamedRanged in the Excel File for a Matching BookMark
    For Each Nm In xlWorkBook.Names
      NmdRng = Nm.Name
      If ActiveDocument.Bookmarks.Exists(NmdRng) = True Then
        Set NmdValue = xlWorkBook.Names(NmdRng).RefersToRange
        'Update the found bookmark
        ActiveDocument.Bookmarks(Bmk).Range.InsertAfter NmdValue
      End If
    Next
    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
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #4  
Old 12-13-2014, 11:21 AM
ptmuldoon ptmuldoon is offline Searching Arrays without Loops? Windows 7 64bit Searching Arrays without Loops? Office 2013
Advanced Beginner
Searching Arrays without Loops?
 
Join Date: Sep 2014
Posts: 93
ptmuldoon is on a distinguished road
Default

Macropod, your unbelievable in the help and support you provide.

You simplified what was I attempting and also made it easier to understand. I continue to learn from all your help!!

Thank you so much!!
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Filling cells with random numbers using loops? (VBA) Sajj Excel Programming 4 04-10-2013 02:29 PM
Searching Arrays without Loops? re-naming arrays in VBA? JDevsFan Excel Programming 4 03-15-2012 08:44 AM
HTML in email loops endlessly rbtroj Outlook 0 05-19-2011 12:29 PM
Searching Arrays without Loops? Powerpoint loops, but not to beginning imeister PowerPoint 1 02-02-2011 02:05 PM
loops within presentations supateach PowerPoint 1 11-23-2010 04:42 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 12:52 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft