I've got code that will extract all Tables from a Word doc.. fantastic!
I've got code that will extract all NON-table content from a Word doc... also fantastic!
I've got code that will use a msg box to go seek out a word or phrase and then extract in the whole row.. again great!
But now I've encountered a scenario where a Table within a Word doc needs to be extracted -- however, it's Table Name is in regular verbiage (above) and outside the table... Go figure... Grrrr ...
I'm hoping there's a way to combine these 2 sets of code that work beautifully to be able to do this:
1=Enter the word/phrase I want sought out ---
2=Once a 'hit' is found -- it will copy/paste/extract that table into a specified Worksheet called: "RESULTS" within the 'Active Workbook' that I would have open --- that would initiate the code..
HERE'S THE CODE THAT USES A SEARCH FEATURE:
HERE'S THE CODE THAT EXTRACTS ALL TABLES OUT OF A WORD DOC (.DOC or .DOCX) -ability to edit in code as needed:
(I only want the table that's found immediately beneath the search phrase -- in this case, not ALL tables)
In advance, thank you - I know there's a brilliant mind out there that knows how to combine something like this..
I've got code that will extract all NON-table content from a Word doc... also fantastic!
I've got code that will use a msg box to go seek out a word or phrase and then extract in the whole row.. again great!
But now I've encountered a scenario where a Table within a Word doc needs to be extracted -- however, it's Table Name is in regular verbiage (above) and outside the table... Go figure... Grrrr ...
I'm hoping there's a way to combine these 2 sets of code that work beautifully to be able to do this:
1=Enter the word/phrase I want sought out ---
2=Once a 'hit' is found -- it will copy/paste/extract that table into a specified Worksheet called: "RESULTS" within the 'Active Workbook' that I would have open --- that would initiate the code..
HERE'S THE CODE THAT USES A SEARCH FEATURE:
Code:
Public Sub FindMultipleSheet****s()
'
'loops through all the sheets within a workbook (except the one you tell it NOT to touch) because
'that one is reserved for pasting findings to it...
'
'Run from standard module, like: Module1.
'Find all data on all sheets!
'Do not search the sheet the found data is copied to!
'List a message box with all the found data addresses, as well!
Dim ws As Worksheet, Found As Range
Dim myText As String, firstAddress As String
Dim AddressStr As String, foundNum As Integer
myText = InputBox("Enter text to find")
If myText = "" Then Exit Sub
For Each ws In ThisWorkbook.Worksheets
With ws
'Do not search sheet25!=== ENTER NAME OF SHEET THAT YOU DO NOT WANT SEARCHED===
If ws.Name = "MASTER" Then GoTo myNext
Set Found = .UsedRange.Find(what:=myText, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
If Not Found Is Nothing Then
firstAddress = Found.Address
Do
foundNum = foundNum + 1
AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf
Set Found = .UsedRange.FindNext(Found)
'Copy found data row to sheet4 Option! === ENTER NAME OF SHEET WHERE YOU WANT RESULTS PLACED===
'IT WILL LOCATE THE UNIQUE WORD OR PHRASE AND EXTRACT EVERYTHING ON THE WHOLE ROW
'this is very helpful to be able to see if this is valid content wanted or not
'IT ALSO WILL PROVIDE A MSG BOX SHOWING EXACT LOCATION OF ALL HITS
Found.EntireRow.Copy _
Destination:=Worksheets("RESULTS").Range("A65536").End(xlUp).Offset(1, 0)
Loop While Not Found Is Nothing And Found.Address <> firstAddress
End If
myNext:
End With
Next ws
If Len(AddressStr) Then
MsgBox "Found: """ & myText & """ " & foundNum & " times." & vbCr & _
AddressStr, vbOKOnly, myText & " found in these cells"
Else:
MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation
End If
End SubHERE'S THE CODE THAT EXTRACTS ALL TABLES OUT OF A WORD DOC (.DOC or .DOCX) -ability to edit in code as needed:
(I only want the table that's found immediately beneath the search phrase -- in this case, not ALL tables)
Code:
Sub ImportWordTableDOC()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim tableNo As Long 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Long 'column index in Excel
Dim resultRow As Long
Dim tableStart As Long
Dim tableTot As Long
Dim wkSht As Worksheet
On Error Resume Next
wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _
"Browse for file containing table to be imported")
If wdFileName = False Then Exit Sub '(user cancelled import file browser)
Set wkSht = ActiveSheet
wkSht.Range("A:AZ").ClearContents
Set wdDoc = GetObject(wdFileName) 'open Word file
With wdDoc
tableNo = wdDoc.Tables.Count
tableTot = wdDoc.Tables.Count
If tableNo = 0 Then
MsgBox "This document contains no tables", _
vbExclamation, "Import Word Table"
ElseIf tableNo > 1 Then
tableNo = InputBox("This Word document contains " & tableNo & " tables." & vbCrLf & _
"Enter the table to start from", "Import Word Table", "1")
End If
resultRow = 4
For tableStart = 1 To tableTot
With .Tables(tableStart)
'copy cell contents from Word table cells to Excel cells
For iRow = 1 To .Rows.Count
For iCol = 1 To .Columns.Count
wkSht.Cells(resultRow, iCol) = WorksheetFunction.Clean(.Cell(iRow, iCol).Range.Text)
Next iCol
resultRow = resultRow + 1
Next iRow
End With
resultRow = resultRow + 1
With wkSht
.Range(.Cells(resultRow, 1), .Cells(resultRow, iCol)).Interior.ColorIndex = 15
End With
resultRow = resultRow + 1
Next tableStart
End With
End SubIn advance, thank you - I know there's a brilliant mind out there that knows how to combine something like this..
