Find value from excel file in word document

[jspedt]

Hi everyone,

I am trying to figure out a macro in excel that would search for a specific value and jump to that point in a specific word file.

As an example:
Cell A1 has the value "Company X" in it. I would like to be able to press Cell A1 and the code then opens the word document and jumps to the "Company X" section of the word file, or if the word file is open already, just jump to the "Company X" section.

Essentially, I would like the code in Excel to act as a table of contents of sorts between the two programs and files, so that I can discuss the value and then click it and be brought into the more in depth explanation in word.

I am suspecting this to be a straight forward code that either looks for the exact formatting or text, however, I am still quite new to VBA coding and this is just beyond my abilities and I have not been able to find any threads addressing it directly, so given the amount of great contributions here I hope some of you guys might be able to assists.

Thanks!

 

[DanteAmor]

Cell A1 has the value "Company X" in it. I would like to be able to press Cell A1 and the code then opens the word document and jumps to the "Company X" section of the word file

Captures the text in cell A1, on sheet Sheet1.
Before, you must update the path where the file is located and obviously the name of the file.

Run the following code:

Sub FindValue()
  Dim WordApp As Word.Application
  Dim WordDoc As Word.Document
  Dim WordContent As Variant
  'Dim WordApp As Object
  'Dim WordDoc As Object
  Dim txt As String
  Dim sPath As String, sName As String
  
  sPath = "C:\full path\"
  sName = "instructions.docx"
  txt = Sheets("Sheet1").Range("A1").Value
  
  If IsFileOpen(sPath & sName) Then
    Set WordApp = GetObject(, "word.Application")
    Set WordDoc = WordApp.Documents(sPath & sName)
    WordDoc.Activate
  Else
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = True
    WordApp.Documents.Open sPath & sName
  End If
  
  Set WordContent = WordApp.ActiveDocument.Content
  With WordContent.Find
    .MatchCase = False
    .Execute FindText:=txt
    If .Found = True Then
      WordApp.Activate
      WordContent.Select
    End If
  End With
End Sub

Function IsFileOpen(strFullPathFileName As String) As Boolean
'// VBA version to check if File is Open. Ivan F Moala. http://www.xcelfiles.com
  Dim hdlFile As Long
  '// Error is generated if you try. opening a File for ReadWrite lock >> MUST BE OPEN!
  On Error GoTo FileIsOpen:
  hdlFile = FreeFile
  Open strFullPathFileName For Random Access Read Write Lock Read Write As hdlFile
  IsFileOpen = False
  Close hdlFile
  Exit Function
FileIsOpen:
  '// Someone has it open!
  IsFileOpen = True
  Close hdlFile
End Function

 

[jspedt]

Captures the text in cell A1, on sheet Sheet1.
Before, you must update the path where the file is located and obviously the name of the file.

Run the following code:

Sub FindValue()
  Dim WordApp As Word.Application
  Dim WordDoc As Word.Document
  Dim WordContent As Variant
  'Dim WordApp As Object
  'Dim WordDoc As Object
  Dim txt As String
  Dim sPath As String, sName As String
 
  sPath = "C:\full path\"
  sName = "instructions.docx"
  txt = Sheets("Sheet1").Range("A1").Value
 
  If IsFileOpen(sPath & sName) Then
    Set WordApp = GetObject(, "word.Application")
    Set WordDoc = WordApp.Documents(sPath & sName)
    WordDoc.Activate
  Else
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = True
    WordApp.Documents.Open sPath & sName
  End If
 
  Set WordContent = WordApp.ActiveDocument.Content
  With WordContent.Find
    .MatchCase = False
    .Execute FindText:=txt
    If .Found = True Then
      WordApp.Activate
      WordContent.Select
    End If
  End With
End Sub

Function IsFileOpen(strFullPathFileName As String) As Boolean
'// VBA version to check if File is Open. Ivan F Moala. http://www.xcelfiles.com
  Dim hdlFile As Long
  '// Error is generated if you try. opening a File for ReadWrite lock >> MUST BE OPEN!
  On Error GoTo FileIsOpen:
  hdlFile = FreeFile
  Open strFullPathFileName For Random Access Read Write Lock Read Write As hdlFile
  IsFileOpen = False
  Close hdlFile
  Exit Function
FileIsOpen:
  '// Someone has it open!
  IsFileOpen = True
  Close hdlFile
End Function

Hi Dante Amor,

Thanks a lot for your input - I really appreciate it.

I can, however, only get the code to partially work after I have modified the path, file name, etc.

When I run the code it opens the correct word file, however, now that word file is empty, i.e. all the information that was written in the word doc seems to be gone - would you have any insight into what might be happening here?

Thanks!

 

[DanteAmor]

The macro does not modify anything in your word.
Try with the file open.
Close all your applications. Just open your excel file and your word file.