Excel - find a specified value in word document table and move it

[ecalid]

Good afternoon all,

I am in the process of creating a macro which looks for a prescribed piece of text in a browsed word document; I have managed to get the macro to locate the text but I need it to move backwards by 2 cells, essentially cut and paste.

It's almost like Excel doesn't recognise that there is a table in the word document and just defaults to the first character of the document.

ChatGTP isn't helping very much so I am wondering if anybody has any experience with this?


Private Sub BrowseButton_Click()
Dim selectedRow As Long
Dim searchValue As String
Dim filePath As String
Dim wordApp As Object
Dim wordDoc As Object
Dim foundRange As Object
Dim insertionText As String
' Get the selected row and search value
selectedRow = ActiveCell.Row
searchValue = ActiveSheet.Cells(selectedRow, 4).Value
' Browse for Word document
With Application.fileDialog(msoFileDialogFilePicker)
.Title = "Select Word Document"
.Filters.Add "Word Documents", "*.docx", 1
If .Show = -1 Then
filePath = .SelectedItems(1)
Else
Exit Sub ' User canceled
End If
End With
' Open Word document
Set wordApp = CreateObject("Word.Application")
Set wordDoc = wordApp.Documents.Open(filePath)
' Search for the value in the Word document
If wordDoc.Content.Find.Execute(FindText:=searchValue) Then
' Get the found range
Set foundRange = wordDoc.Content
' Copy the found value
foundRange.Copy
Dim startPosition As Long
startPosition = foundRange.Start
' Set the selection to the start position
wordApp.Selection.SetRange Start:=startPosition, End:=startPosition
' Simulate pressing "Tab" back twice
Application.SendKeys "{TAB 2}"
' Add onto any existing text
insertionText = ActiveSheet.Cells(selectedRow, 4).Value
wordApp.Selection.TypeText insertionText
' Display the result in a MsgBox
MsgBox "Value found in Word document '" & filePath & "' and inserted at location: " & wordApp.Selection.Start & " - " & wordApp.Selection.End
Else
MsgBox "Value not found in the Word document '" & filePath & "'."
End If
End Sub

Could anybody please help me with this?

Many thanks in advance.

[Dave]

Hi again ecalid. You don't seem to be referencing any tables in your code? Not sure that I understand but maybe this will get you started. HTH. Dave

With wordApp.Activedocument
tableTot = .tables.Count
For tablestart = 1 To tableTot
With .tables(tablestart)
For irow = 1 To .Rows.Count ' table rows
For icol = 1 To .Columns.Count 'table columns
If .cell(irow, icol).Range.Text = searchValue Then
If icol > 2 Then
MsgBox "Search text in table(Move): " & tablestart & " Column: " & icol & " Row: " & irow
.cell(irow, icol - 2).Range.Text = .cell(irow, icol).Range.Text
Else
MsgBox "Search text in table(No Move): " & tablestart & " Column: " & icol & " Row: " & irow
End If
End If
Next icol
Next irow
End With
Next tablestart
End With

[snb]

I'd use:
searchstring "snb"


Sub M_snb()
c00 = "snb"

With Tables(1)
n = .Columns.Count
y = UBound(Split(Split(Replace(.Range, vbCr & Chr(7) & vbCr & Chr(7), vbCr & Chr(7)), c00)(0), Chr(7)))
.Cell(y \ n + 1, y Mod n - 1).Range.Text = c00
End With
End Sub