Word VBA Find And Replace

Question

I am trying to find all of the cells with a certain text of "0.118" in column 2 of my table and do a list of commands for that row I am also trying to take the value from column 5 of that selected text found in that row and subtract the value I put in the input box for that row.

The problem I am having is that it only changes one of my found "0.118" and not all of them in each row.

And I can't figure out how to search for the column(5) of that selected row.

Any help would be greatly appreciated.

Thank you.

Sub ConvertTo_3MM()

Dim oTable As Table
Dim stT As Long, enT As Long
Dim stS As Long, enS As Long

With Selection.Find
    
    .Forward = True
    .MatchPhrase = True
    .Execute FindText:="0.118"
            
End With
    
For Each oTable In ActiveDocument.Tables
    
    Do While Selection.Find.Execute = True

        stT = oTable.Range.Start
        enT = oTable.Range.End

        stS = Selection.Range.Start
        enS = Selection.Range.End

        If stS < stT Or enS > enT Then Exit Do

        Selection.Collapse wdCollapseStart

        If ActiveDocument.Tables.Count >= 1 Then
            With ActiveDocument.Tables(1).Cell(nRow, 2).Range
                .Text = "3 MM" & vbCrLf & "-" & vbCrLf & "6 MM"
            End With
        End If

        Selection.MoveRight Unit:=wdCell
        
        If ActiveDocument.Tables.Count >= 1 Then
            With ActiveDocument.Tables(1).Cell(nRow, 3).Range
                .InsertAfter Text:=vbCrLf & "-" & vbCrLf & "SHANK"
            End With
        End If

        Selection.MoveRight Unit:=wdCell
        Selection.MoveRight Unit:=wdCell
                                       
        response = InputBox("Cut Length For 3 MM")

        If ActiveDocument.Tables.Count >= 1 Then
            With ActiveDocument.Tables(1).Cell(nRow, 5).Range
                .Text = response & vbCrLf & "-" & vbCrLf & (column(5).value - response)
            End With
        End If
                                 
        Selection.Find.Execute Replace:=wdReplaceAll
                    
    Loop
            
    Selection.Collapse wdCollapseEnd
            
Next
    
    Application.ScreenUpdating = True
    
End Sub

Answer 1

I would be very surprised if the code in your question actually does anything as it doesn't even compile.

Your code is rather a confused mess so I'm not entirely certain that I have correctly understood what you are attempting to do, but try this:

Sub ConvertTo_3MM()
    Application.ScreenUpdating = False

    Dim oTable As Table
    Dim response As String
    
    For Each oTable In ActiveDocument.Tables
        With oTable.Range
            With .Find
                .Forward = True
                .MatchPhrase = True
                .Text = "0.118"
                .Wrap = wdFindStop
                .Execute
            End With

            Do While .Find.Found = True
                .Text = "3 MM" & vbCr & "-" & vbCr & "6 MM"
                With .Rows(1)
                    .Cells(3).Range.InsertAfter Text:=vbCr & "-" & vbCr & "SHANK"
                    response = Val(InputBox("Cut Length For 3 MM"))
                    With .Cells(5).Range
                        .Text = response & vbCr & "-" & vbCr & (Val(.Text) - response)
                    End With
                End With
                .Collapse wdCollapseEnd
                .Find.Execute
            Loop
        End With
    Next
    
    Application.ScreenUpdating = True
    
End Sub

Answer 2

Thi may not be a solution, but I do see some problems:

You do:

For Each oTable In ActiveDocument.Tables

Then you do inside that loop:

    Do While Selection.Find.Execute = True

but this Find will not be limited to the table of the For Each loop.

Though harmless, inside this Do While loop you do:

        If ActiveDocument.Tables.Count >= 1 Then

but of course this is true because the For Each already determined there is at least 1 table.

I suggest you lookup the documentation of Find , rethink the logic and then run it step by step in the debugger to see what the code is doing.

Answer 3

Try this code:

Sub ConvertTo_3MM()
    Dim oTable As Table, rng As Range
    Dim nRow As Long, response As String
    
    For Each oTable In ActiveDocument.Tables
        With oTable
            Set rng = .Range
            Do
                If rng.Find.Execute("0.118") Then
                    If rng.Information(wdEndOfRangeColumnNumber) = 2 Then
                        nRow = rng.Information(wdEndOfRangeRowNumber)
                        .Cell(nRow, 2).Range.Text = "3 MM" & vbCrLf & "-" & vbCrLf & "6 MM"
                        .Cell(nRow, 3).Range.InsertAfter Text:=vbCrLf & "-" & vbCrLf & "SHANK"
                        response = Val(InputBox("Cut Length For 3 MM"))
                        .Cell(nRow, 5).Range.Text = response & _
                            vbCrLf & "-" & vbCrLf & (Val(.Cell(nRow, 5).Range.Text) - response)
                    End If
                Else
                    Exit Do
                End If
                rng.Collapse wdCollapseEnd
            Loop
        End With
    Next
    Application.ScreenUpdating = True
End Sub

Before

After