Solved: Word table: the range cannot be deleted error

[fboehlandt]

Hello,
I am trying to replace the cell contents in a Word table. The exemplary code is given below:

Sub MyAccent()
Dim oCell As Word.Cell

With Selection
' \\ Check if selection is in a table
If .Information(wdWithInTable) Then
For Each oCell In .Tables(1).Range.Cells
If Trim(oCell.Range.Text) Like "*sss*" Then
oCell.Range.Text = Left(oCell.Range.Text, Len(oCell.Range.Text) - 5)
oCell.Range.Select
Selection.OMaths.Add Range:=Selection.Range
oCell.Range.Select
Selection.OMaths(1).Functions.Add(Selection.Range, wdOMathFunctionAcc).Acc _
.Char = 8411
ElseIf Trim(oCell.Range.Text) Like "*ss*" Then
oCell.Range.Text = Left(oCell.Range.Text, Len(oCell.Range.Text) - 4) '!<--
oCell.Range.Select
Selection.OMaths.Add Range:=Selection.Range
oCell.Range.Select
Selection.OMaths(1).Functions.Add(Selection.Range, wdOMathFunctionAcc).Acc _
.Char = 776
ElseIf Trim(oCell.Range.Text) Like "*s*" Then
oCell.Range.Text = Left(oCell.Range.Text, Len(oCell.Range.Text) - 3)
oCell.Range.Select
Selection.OMaths.Add Range:=Selection.Range
oCell.Range.Select
Selection.OMaths(1).Functions.Add(Selection.Range, wdOMathFunctionAcc).Acc _
.Char = 775
Else
oCell.Range.Select
Selection.OMaths.Add Range:=Selection.Range
End If
Next
End If
End With
End Sub

The moment the code gets to the marked line I receive the 'The range cannot be deleted error'. The first cell actually does change but that change must invoke the error later on. Can anyone help please?

[macropod]

Without knowing what's in the cells, it's hard to say what the issue is. However, you might try:
Sub MyAccent()
Dim wdCell As Word.Cell, wdRng As Word.Range
With Selection
If .Information(wdWithInTable) Then
For Each wdCell In .Tables(1).Range.Cells
Set wdRng = wdCell.Range
wdRng.End = wdRng.End - 1
With wdRng
If InStr(.Text, "sss") > 0 Then
.Text = Left(.Text, InStr(.Text, "sss") - 1)
.OMaths.Add Range:=Selection.Range
.OMaths(1).Functions.Add(wdRng, wdOMathFunctionAcc).Acc.Char = 8411
ElseIf InStr(.Text, "ss") > 0 Then
.Text = Left(.Text, InStr(.Text, "ss") - 1)
.OMaths.Add Range:=wdRng
.OMaths(1).Functions.Add(wdRng, wdOMathFunctionAcc).Acc.Char = 776
ElseIf InStr(.Text, "s") > 0 Then
.Text = Left(.Text, InStr(.Text, "s") - 1)
.OMaths.Add Range:=wdRng
.OMaths(1).Functions.Add(wdRng, wdOMathFunctionAcc).Acc.Char = 775
Else
.OMaths.Add Range:=wdRng
End If
End With
Next
End If
End With
End Sub

[fboehlandt]

Hello macropod,
thanks for your response, I feel like we are pretty close. I include an example for my source table:

Heading1 Heading2 Heading 3
12.232s 14.234ss 123.222sss
5.434 13.978ss 0.987

after execution all number should be math-type and accented depending on the number of "s". When execution gets to cell 6, I get the 'The requested member of the collection does not exist' - error. Can you advise please?
Thanks

p.s. the code does not necessarily have to run through the headers. The indicator for accents ("s") can be changed to something else in the Excel-source if it makes life easier

[fboehlandt]

Hi,
I figured it out, it was just a typo ;) (See line 11)

Sub MyAccent()
Dim wdCell As Word.Cell, wdRng As Word.Range
With Selection
If .Information(wdWithInTable) Then
For Each wdCell In .Tables(1).Range.Cells
Set wdRng = wdCell.Range
wdRng.End = wdRng.End - 1
With wdRng
If InStr(.Text, "sss") > 0 Then
.Text = Left(.Text, InStr(.Text, "sss") - 1)
.OMaths.Add Range:=wdRng
.OMaths(1).Functions.Add(wdRng, wdOMathFunctionAcc).Acc.Char = 8411
ElseIf InStr(.Text, "ss") > 0 Then
.Text = Left(.Text, InStr(.Text, "ss") - 1)
.OMaths.Add Range:=wdRng
.OMaths(1).Functions.Add(wdRng, wdOMathFunctionAcc).Acc.Char = 776
ElseIf InStr(.Text, "s") > 0 Then
.Text = Left(.Text, InStr(.Text, "s") - 1)
.OMaths.Add Range:=wdRng
.OMaths(1).Functions.Add(wdRng, wdOMathFunctionAcc).Acc.Char = 775
Else
.OMaths.Add Range:=wdRng
End If
End With
Next
End If
End With
End Sub

Many thanks!!

[macropod]

Oops!

[fumei]

"it was just a typo"

Are you using Option Explicit?

[macropod]

It was my typo - I left in one 'Range:=Selection.Range' that should have been changed to 'Range:=wdRng'.

[fumei]

ah


I am well (as opposed to shell) shocked