Thread: [Solved] Pulling Data From Excel
View Single Post
 
Old 12-07-2014, 06:39 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

Ok, I've been trying to follow what you posted, and honestly it looks more advanced than I can understand at the moment.

And I've been searching and preparing my own code as well in working to learn and figure it out.

Again, the end goal here to is starting from Word, to compare the BookMarks in Word to the NamedRanges in an Excel file, and if matches found to add the values(text) of the Named ranges to Word.

This code is a work in process. Currently, I'm trying to figure how to loop the Bookmarks and compare to Excel.

But I think it may be better/faster to have both the BookMarks and NamedRanges in separate arrays, and then compare them for matches? And then take just the matches and update the bookmarks?

Work in Process Code
Code:
Sub Test()
    Dim f, xlWorkBook As Object
    Dim Nm As Variant
    Dim NewPath, xlNamedRange, MyText As String
    Dim Bmk() As String
    Dim x, j 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)
        'MsgBox "The New File Path is: " & NewPath
        Set xlWorkBook = GetObject(f.SelectedItems(1))
        
        'Put all Excel Named Ranges into an Array
        For Each Nm In xlWorkBook.Names
            xlNamedRange = Nm.Name

            If xlNamedRange = ActiveDocument.Bookmarks("Company_Name") Then
                'Selection.TypeText (MyText)
                MyText = "String you want to insert"
                'UpdateBM "Company_Name", MyText
            End If
        Next Nm
    Else 'user clicked cancel
        Exit Sub
    End If
    
    'Read all the Book Marks into an Array
    x = ActiveDocument.Bookmarks.Count
    ReDim Bmk(x)
    For j = 1 To x
        Bmk(j) = ActiveDocument.Bookmarks(j).Name
        UpdateBM ActiveDocument.Bookmarks(j).Name, ""
        ActiveDocument.Bookmarks(j).Range.InsertAfter "add this after"
    Next j
    
    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