Macro to delete empty cells in Word 2007

Tags:
Microsoft Office 2007 small business wit...
macro
Word
2007
table
cells
July 18, 2010 at 14:23:51
Specs: Windows XP
I am looking for a macro to delete all empty cells in a Word 2007 table (data would move up). Can anyone help? Thank you kindly.

See More: Macro to delete empty cells in Word 2007

Report •

#1
July 19, 2010 at 04:58:40
Hi,

Tables in Word are not as straight-forward as cells in Excel, particularly when cells are merged (either vertically or horizontally)

Three questions:
1. Do your tables ever have merged cells
2. If you have an empty cell in a table, but other cells on the same row are not empty, does the data from the cell below get moved up, and if the cell below that is empty does the data from the one below that get moved up.
3. If you move a cell up to fill an empty cell above it, what happens in the last row.

Is this what happens:
Original

1	1	1
2	2	2
3		
4	4	
5	5	5

Final:
1	1	1
2	2	2
3	4	5
4	5	
5

Regards


Report •

#2
July 19, 2010 at 13:44:56
Hello,

Thank you for your prompt reply.

1. The table will never contain any merged cells.
2. Yes, once a cell is deleted, the data should move up in all cases.
3. The number of rows will always end up being the same (i.e equal number of cells in each one of a two-column table)

Original

11
2-
-2
33
-4
4-
5-

-5
66

Final

11
22
33
44
55
66

Regards


Report •

#3
July 19, 2010 at 14:54:30
Hi,

Try this.
The following code will 'remove' empty cells in word tables.
It actually copies data from the next non-empty cell below the empty cell, in the same column, then deletes the contents of that cell.

If the selection is inside a table, the macro only runs on that table.
If the selection is not in a table, the macro runs on all tables in the document.

The new empty cells are left as empty, unless a whole row or rows at the bottom are empty, in which case it deletes the row(s). In your example as the final number of rows is less than the number to start with, the excess will be removed.

Any tables with merged cells generate a warning message - click OK to continue - the table with the merged cells is skipped and the macro moves on to the next table (if any).

As you have no merged cells, the macro should work OK.

I would suggest that you add this to a button on the quick access toolbar.
First add it to the 'Normal' template -
In Word click Alt +f11 (the Alt key and function key 11 clicked together)
This opens the Visual basic window.
In the left-side pane select Normal (if the Project Explorer is not visible, click View from the Visual Basic menu bar, then 'Project Explorer' from the drop-down.
Right-click 'Normal' and select Add, then Module (not Class Module)
Double click the name of the new module (typically Module1), under the Modules folder.
In the large visual basic window enter this:

Option Explicit

Sub MoveCells()
Dim objTable As Table
Dim intTblCount As Integer
Dim n As Integer

'turn off screen updating to increase speed
Application.ScreenUpdating = False
With ActiveDocument
    'if selection is in a table act only on this table,
    If Selection.Information(wdWithInTable) = True Then
        'single table option
        Set objTable = Selection.Tables(1)
        Call TableCellDelete(objTable)
        Else
        'else act on all tables
        intTblCount = .Tables.Count
        For n = 1 To intTblCount
            Set objTable = .Tables(n)
            Call TableCellDelete(objTable)
        Next n
    End If
    Set objTable = Nothing
End With
'restore screen updating
Application.ScreenUpdating = True
End Sub

Sub TableCellDelete(OneTable As Table)
'subroutine to handle cell deletes in one table
Dim intCol As Integer
Dim intRow As Integer
Dim intEqual As Integer
Dim blnMerged As Boolean
Dim rngCell As Cell
Dim intCols As Integer
Dim blnCopyClear As Boolean
Dim blnRowEmpty As Boolean
Dim m As Integer
Dim n As Integer
Dim o As Integer

'test that cell has no merged rows or columns
'set merged cell flag to false
blnMerged = False
intEqual = OneTable.Rows(1).Cells.Count
For n = 2 To OneTable.Rows.Count
    If OneTable.Rows(n).Cells.Count <> intEqual Then blnMerged = True
Next n
If blnMerged = True Then GoTo Merged

intEqual = OneTable.Columns(1).Cells.Count
For n = 2 To OneTable.Columns.Count
    If OneTable.Columns(n).Cells.Count <> intEqual Then blnMerged = True
Next n
If blnMerged = True Then GoTo Merged

'look for empty cells in each row
'table has no merged cells - so get column count
intCols = OneTable.Columns.Count
'loop through all rows except the last one
For m = 1 To OneTable.Rows.Count - 1
    For n = 1 To intCols
        If CellData(OneTable.Rows(m).Cells(n)) = "" Then
            'copy text from same column in next row or below
            blnCopyClear = False
            For o = m + 1 To OneTable.Rows.Count
                If CellData(OneTable.Rows(o).Cells(n)) <> "" Then
                    OneTable.Rows(m).Cells(n).Range.Text = _
                         CellData(OneTable.Rows(o).Cells(n))
                    'clear copied cell's contents
                    OneTable.Rows(o).Cells(n).Range.Text = ""
                    'flag that we have done a copy & clear
                    blnCopyClear = True
                End If
                'don't look in any more rows if we have copied data
                If blnCopyClear = True Then Exit For
            Next o
        End If
    Next n
Next m

'remove any fully blank rows - strat at last row
For m = OneTable.Rows.Count To 2 Step -1
    blnRowEmpty = True
    For n = 1 To intCols
        If CellData(OneTable.Rows(m).Cells(n)) <> "" _
                    Then blnRowEmpty = False
    Next n
    'delete empty row
    If blnRowEmpty = True Then
        OneTable.Rows(m).Delete
    End If
Next m
Exit Sub

Merged:
MsgBox "This routine does not work on tables with merged cells"
End Sub

Private Function CellData(contents As Cell)
    'removes end of cell marker from text in cell
    'and returns only the text
    CellData = Left(contents.Range.Text, Len(contents.Range.Text) - 2)
End Function

Select: 'File' - 'Save - Normal' from the visual basic menu bar.
Use Alt + f11 to return to the main Word window.
Goto the Quick Access toolbar and click the drop-down arrow at the end and click 'More Commands'
Select the 'Customize' tab on the left, and in the 'Choose commands from:' drop down, select 'Macros'.
Select where you want it to go on the Quick Access Toolbar by selecting an item in the right-hand side pane.
In the left hand side pane, find Normal.Module1.MoveCells, select it and click the 'Add>>' button.
Click OK
There is now a new button on the tollbar which will run your new macro to 'delete' empty table cells.

As the changes made by macros cannot be undone test this on a backup copy of your document and ensure that it works as intended. It has only been tested on limited sample data and has not been tested in your environment.

Always make a backup copy of your document before running this macro.

Regards


Report •

Related Solutions
See More ↓

#4
July 19, 2010 at 15:13:30
Hello,
Yes! I have run it several times on different tables. It does work flawlessly! You have been very helpful.
Thanks again.

Report •

#5
July 19, 2010 at 15:44:30
You're very welcome.

Regards

Humar


Report •
Start a discussion

Ask Question