Search code examples
excelvbaloopsms-wordselection

Word VBA: Need help on Selection.Find .Text parameters - currently causing an infinite loop


Currently, I am creating a macro where I can move data from Excel into Word tables. We want to keep the formatting of the existing Word tables and only move the data into each cell. The data involved are dollars (#,###), per shares (#.##), and percentages (#.#%).

My issue right now is that in Excel the number can be 80.0% but shows up as 0.8 in Word, which when I use the .Text("[0-9].[0-9]") function, it goes into an infinite loop. I need something that either only selects the exact criteria (i.e. #.#) and not a unit more OR when transcribing from Excel, makes numbers like 80.0% show up as 0.80 or 80.0%.

I know about the copy and paste special features, but either the table formatting doesn't match exactly like the original or when linking cell by cell, the refresh takes too long. Have also used asterisk as wildcard in different places, but did not work.

I did see something about regex that looks like it could potentially help with strict criterias? Looking forward to hearing from everyone and learn more about VBA, meanwhile I'll continue my research. Thank you!

Here is the code:

Sub Seg1_QTD()  
Dim objExcel As New Excel.Application 
Dim exWb As Excel.Workbook 
Dim ExcelFileName As String 
Dim i As Integer   

ExcelFileName = "LocationHere" 
Set exWb = objExcel.Workbooks.Open("Excel.xlsm", ReadOnly:=True, CorruptLoad:=xlExtractData)  

'Change the # for ActiveDocument.Tables dependent on quarter 
If exWb.Sheets("READ ME").Range("B8") = "Q1" Then 
  i = 2 
Else 
  i = 3  
End If  

'There are other lines, I included one to simplify 
With ActiveDocument.Tables(i) .Cell(5, 3).Range.Text = exWb.Sheets("Segment").Cells(7, 5)  
End With  

exWb.Close SaveChanges:=False  
Set exWb = Nothing   
'===================FORMATTTING==================================  

Dim rngOriginal As Range 
Dim strTemp As String  

Application.ScreenUpdating = False   

'Set range of table 
Set rngOriginal = ActiveDocument.Range( \_ Start:=ActiveDocument.Tables(i).Cell(5, 3).Range.Start, \_ End:=ActiveDocument.Tables(i).Cell(23, 6).Range.End) 

rngOriginal.Select   
With Selection.Find 
.Wrap = wdFindStop 
.ClearFormatting 
.Text = "\[0-9\].\[0-9\]"  
.Replacement.Text = "" 
.Forward = True 
.Format = False 
.MatchCase = False 
.MatchWholeWord = False 
.MatchAllWordForms = False 
.MatchSoundsLike = False 
.MatchWildcards = False   

Do While .Execute 
strTemp = Val(Selection.Range) 
Selection.Range = Format((strTemp), "0.0%")  
Selection.Collapse wdCollapseEnd 
rngOriginal.Select 
Loop 
End With 

i = 0   

End Sub

Solution

  • Assume the number 0.8 is in a cell within rngOriginal.

    • Search for the number using .Text = "[0-9].[0-9]" to find the cell containing 0.8. Then update the number 0.8 to 80.0%. The first iteration of the loop is successful.
    • rngOriginal.Select changes the Selection object.
    • During the next Do While .Execute run, it searches for numbers from the beginning of rngOriginal.
    • It locates the 0.0 in 80.0%, the cell is updated with 80.0%% (0.0 => 0.0%), and continues searching...
    • This results in an infinite loop.

    • Below code is a sample to locate the number and update with percentage.
    Option Explicit
    Sub SearchPercent()
    Dim rngOriginal As Range
    Dim strTemp As String, iEnd As Long
    'Set range of table
    Set rngOriginal = ActiveDocument.Range( _
        Start:=ActiveDocument.Tables(1).Cell(5, 3).Range.Start, _
        End:=ActiveDocument.Tables(1).Cell(23, 6).Range.End)
        iEnd = rngOriginal.End
        With rngOriginal.Find
            .Wrap = wdFindStop
            .ClearFormatting
            .Text = "[0-9].[0-9]"
            .Replacement.Text = ""
            .Forward = True
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = True
            Do While .Execute
                If rngOriginal.Start > iEnd Then Exit Do
                strTemp = Val(rngOriginal.Text)
                rngOriginal.Text = Format((strTemp), "0.0%")
                rngOriginal.Collapse wdCollapseEnd
            Loop
        End With
    End Sub