Autofilling Pre-Determined Text into Selected Table Cells by a Macro

[roy]

Hello,

I have a simple idea, which I'm hoping someone can help me with.

I have a table with several rows and columns. I would like to be able
to select a cell or multiple cells and have a macro:

(1) Delete the contents of the cell(s).
(2) Autofill the selected cell(s) with a specific, formatted text
(e.g. "TEST").

If anyone can help me, I would be so appreciative!

Thanks,
Roy

 

[Greg Maxey]

Not extensively tested and will likely crash in a non-uniform table:

Sub ScratchMacro()
Dim oColS As Long, oRowS As Long, oColE As Long, oRowE As Long
Dim i As Long, j As Long
Dim oTbl As Word.Table
With Selection
If .Information(wdWithInTable) Then
oColS = .Information(wdStartOfRangeColumnNumber)
oRowS = .Information(wdStartOfRangeRowNumber)
oColE = .Information(wdEndOfRangeColumnNumber)
oRowE = .Information(wdEndOfRangeRowNumber)
Else
Exit Sub
End If
End With
Set oTbl = Selection.Tables(1)
For i = oRowS To oRowE
For j = oColS To oColE
oTbl.Cell(i, j).Range.Text = "TEST"
Next j
Next i
End Sub

 

[roy]

Hi Greg,

This is great! Is there anyway to format the text? For example,
change the font size and make it bold?

Thanks,
Roy

 

[Greg Maxey]

As expected you may encounter erratic results in a non-uniform table
(table with split or merged cells). I don't know how you could work
around this, but you could add some flags to the macro to make you
awared of them:

Sub ScratchMacro()
Dim oColS As Long, oRowS As Long, oColE As Long, oRowE As Long
Dim i As Long, j As Long
Dim oTbl As Word.Table
If Not Selection.Information(wdWithInTable) Then
Exit Sub
Else
Set oTbl = Selection.Tables(1)
End If
If Not oTbl.Uniform Then
If MsgBox("This table contains merged or split cells which may result
in erratic results." _
& " Do you wish to continue?", vbYesNo, "Irregular Table!") =
vbYes Then
With Selection
oColS = .Information(wdStartOfRangeColumnNumber)
oRowS = .Information(wdStartOfRangeRowNumber)
oColE = .Information(wdEndOfRangeColumnNumber)
oRowE = .Information(wdEndOfRangeRowNumber)
End With
Else
Exit Sub
End If
End If
Set oTbl = Selection.Tables(1)
For i = oRowS To oRowE
For j = oColS To oColE
oTbl.Cell(i, j).Range.Text = "TEST"
Next j
Next i

 

[roy]

Hi Greg,

Thank you for working so hard on this! I really appreciate it. I did
figure out the formatting issue (bold, different font size, etc.).

Thanks,
Roy

 

[Greg Maxey]

Yes. While you are working with the cell range you can do whatever you
want with the text formatting:

Sub ScratchMacro()
Dim oColS As Long, oRowS As Long, oColE As Long, oRowE As Long
Dim i As Long, j As Long
Dim oTbl As Word.Table
If Not Selection.Information(wdWithInTable) Then
Exit Sub
Else
Set oTbl = Selection.Tables(1)
End If
If Not oTbl.Uniform Then
If MsgBox("This table contains merged or split cells which may result
in erratic results." _
& " Do you wish to continue?", vbYesNo, "Irregular Table!") =
vbYes Then
With Selection
oColS = .Information(wdStartOfRangeColumnNumber)
oRowS = .Information(wdStartOfRangeRowNumber)
oColE = .Information(wdEndOfRangeColumnNumber)
oRowE = .Information(wdEndOfRangeRowNumber)
End With
Else
Exit Sub
End If
End If
Set oTbl = Selection.Tables(1)
For i = oRowS To oRowE
For j = oColS To oColE
With oTbl.Cell(i, j).Range
.Text = "TEST"
With .Font
.Name = "Arrial Narrow"
.Size = 18
.Bold = True
End With
End With
Next j
Next i
End Sub