Shade Blank Cells in Word Table

[epattee]

Hello,

I have a document that is formatted with 6 columns and a large number of rows. Cells within this table formatting are sometimes blank and must be shaded with a texture. I was wondering if there is a macro that can search the selected tables for blank cells and fill them in with the following texture and color:

Texture: Lt Grid
Background: Light Grey
Foreground: White

I need the macro to be able to run with merged horizontal and merged vertical cells. It also needs to recognize numbering and text as content in the cells.

Thank you for your help!

[gmayor]

The following should work

Dim oCell As Cell
For Each oCell In Selection.Tables(1).Range.Cells
If Len(oCell.Range) = 2 Then
oCell.Range.Shading.Texture = wdTextureDarkCross
oCell.Range.Shading.ForegroundPatternColor = wdColorWhite
oCell.Range.Shading.BackgroundPatternColor = wdColorGray20
End If
Next oCell

[gmaxey]

This will do the same thing as Graham's. With a large table it might be a bit quicker:



Sub ScratchMacroII()
'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 10/23/2018
Dim oCell As Cell
Set oCell = ActiveDocument.Tables(1).Range.Cells(1)
Application.ScreenUpdating = False
On Error Resume Next
Do
If Len(oCell.Range) = 2 Then
With oCell.Range.Shading
.Texture = wdTextureDarkCross
.ForegroundPatternColor = wdColorWhite
.BackgroundPatternColor = wdColorGray20
End With
End If
Set oCell = oCell.Next
Loop Until Err.Number <> 0
Application.ScreenUpdating = True
lbl_Exit:
Exit Sub
End Sub



Note: Graham's version assumes the cursor is in the table to process. Mine assumes the table to process is the first table.


Sorry Graham. There is so little of interest that I had to do something before I forget how ;-)

[epattee]

Thank you both for your responses! I tried both macros with my formatting.

Graham, your code ran great, but it does not recognize the numbering that I have in the first column of my table. I have a multilevel list that numbers the start of a new table, this column that the number appears in gets the shading which if possible I would prefer it be white.

Greg, your code did not seem to run with my formatting. I am not very experienced, but I probably should specify that I am working in a template that will be used by co-workers to start new documents to write records. Your code did not send any error or bring up the debugger, I just don't see any shading happening in any of the tables in my template.

[gmaxey]

We will probably need to see a sample document. The code I posted was ran with a simple 5 col by 50 row table with a bit of text peppered in. In ran fine and shaded the empty cells.

[epattee]

I have attached a snip of what an example table would be without the shading, and then what the same table looks like after I run Grahams code. As you can see it has the column that contains the 6.11 shaded.

I tested Greg's code in a different template with the same tables and the code shaded exactly like Grahams.

Does Greg's code start at the first page of the document and work through each table in the document? My template contains Sections A-K and only tables in Section I need to have black cells shaded. Graham's code that runs the selected table, I would guess, would be best suited for this situation. This is because each time a user is working in the template there can be any number of tables and blank cells within Section I.

Thank you for your help,
Emily

23078

[gmaxey]

You make it hard. To test our code we will have to create a table that looks like yours. Just attach a document with the table please.

[gmaxey]

Try this:


Sub ScratchMacroII()
'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 10/23/2018
Dim oCell As Cell
Set oCell = Selection.Tables(1).Range.Cells(1)
Application.ScreenUpdating = False
On Error Resume Next
Do
If Not IsList(oCell.Range) Then
If Len(oCell.Range) = 2 Then
With oCell.Range.Shading
.Texture = wdTextureDarkCross
.ForegroundPatternColor = wdColorWhite
.BackgroundPatternColor = wdColorGray20
End With
End If
End If
Set oCell = oCell.Next
Loop Until Err.Number <> 0
Application.ScreenUpdating = True
lbl_Exit:
Exit Sub
End Sub
Function IsList(oRng) As Boolean
Select Case oRng.ListFormat.ListType
Case wdListNoNumbering
IsList = False
Case wdListListNumOnly
IsList = True
Case wdListBullet
IsList = True
Case wdListSimpleNumbering
IsList = True
Case wdListOutlineNumbering
IsList = True
Case wdListMixedNumbering
IsList = True
Case wdListPictureBullet
IsList = True
Case Else
End Select
lbl_Exit:
Exit Function
End Function

[epattee]

Greg,

Thank you for all your help, that worked perfectly. I will be sure to attach an actual word document next time I have a question, and not just a picture.

Emily

[gmaxey]

You're welcome. In keeping with the stated goal of a little increased speed in large tables, I suppose the if statements in the first procedure should be transposed:


Sub ScratchMacroII()
'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 10/23/2018
Dim oCell As Cell
Set oCell = Selection.Tables(1).Range.Cells(1)
Application.ScreenUpdating = False
On Error Resume Next
Do
If Len(oCell.Range) = 2 Then
If Not IsList(oCell.Range) Then
With oCell.Range.Shading
.Texture = wdTextureDarkCross
.ForegroundPatternColor = wdColorWhite
.BackgroundPatternColor = wdColorGray20
End With
End If
End If
Set oCell = oCell.Next
Loop Until oCell Is Nothing
Application.ScreenUpdating = True
lbl_Exit:
Exit Sub
End Sub

[epattee]

Greg,

This final code is working great! I have encountered a new task with this "Shading" that I am not sure is possible. It would be beneficial to my formatting if the first column of my table did not get shaded even though some of the cells in that column will be blank. I have attached a word document with the table format that I am using along with the code I am using to shade the tables. The first table is what the current code will do, and the second table is what I would like to happen if possible.

Thank you again,
Emily

23103

[gmaxey]

You will use the same IsList function as before:


Sub ScratchMacroII()
'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 10/23/2018
Dim oCell As Cell
Set oCell = Selection.Tables(1).Range.Cells(1)
Application.ScreenUpdating = False
On Error Resume Next
Do
If Len(oCell.Range) = 2 Then
If Not IsList(oCell.Range) Then
If Not oCell.Range.Information(wdEndOfRangeColumnNumber) = 1 Then
With oCell.Range.Shading
.Texture = wdTextureDarkCross
.ForegroundPatternColor = wdColorWhite
.BackgroundPatternColor = wdColorGray20
End With
End If
End If
End If
Set oCell = oCell.Next
Loop Until oCell Is Nothing
Application.ScreenUpdating = True
lbl_Exit:
Exit Sub
End Sub

[Kilroy]

Hello, when I try to use this it says IsList is not defined.

[gmaxey]

You need the IsList function from the earlier post

[Kilroy]

ummmmm…. I should have seen that. What a newbie. LOL Thanks Greg.

[Kilroy]

I tried adding a column to the "set oCell" line. Didn't work. How do I get it to focus on a specific column as opposed to the whole table?