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

Timothy Rylatt · Accepted Answer · 2021-06-18 14:45:57Z

2

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

edited Jun 18, 2021 at 14:45

answered Jun 18, 2021 at 13:32

Timothy Rylatt

7,9352 gold badges13 silver badges15 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

Mapleleaf Over a year ago

I am trying to change for each row that the 0.118 is found, column(2) to 3 MM - 6 MM. Column(3) to add - SHANK. And, column(5) each row that 0.118 is found may have a different length for my input so I need to subtract that input number from the value in column(5) of that row and replace column(5) with the input number, a - then the original column(5) minus the input value. I'm sorry this is a bit confusing for me as I am self educating myself on Word VBA

Timothy Rylatt Over a year ago

@Mapleleaf - see edited answer. I have modified the code so that the input box displays for each match found.

Paul Ogilvie · Accepted Answer · 2021-06-18 13:16:50Z

1

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.

answered Jun 18, 2021 at 13:16

Paul Ogilvie

25.4k4 gold badges26 silver badges43 bronze badges

Comments

Алексей Р · Accepted Answer · 2021-06-18 14:00:17Z

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

Collectives™ on Stack Overflow

Word VBA Find And Replace

3 Answers 3

2 Comments

Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

2 Comments

Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related