How to delete Multiple empty rows in Word table

You can use a macro to delete all the empty rows. The macro below should do
the job.

---------------
Sub DeleteEmptyRows_AllTables()

Dim oTable As Table Dim oRow As Row For Each oTable In ActiveDocument.Tables For Each oRow In oTable.Rows 'Check whether row is empty - delete if it is If Len(oRow.Range.Text) = oRow.Cells.Count * 2 + 2 Then oRow.Delete End If Next oRow Next oTable

Exit Sub

End Sub
---------------

How it works:The macro iterates through all tables in the active document and finds (and deletes) the empty rows by checking the total string length of each row.- An empty cell includes a cell maker with a length of 2.- In addition, each row includes an end of row marker with a length of 2.Therefore, the row is empty if the string length is equal to the number of

cells in the row multiplied by 2 + 2.

You will find another macro version at:
http://word.mvps.org/FAQs/MacrosVBA/DeleteEmptyRows.htm

NOTE that both macro versions will fail if the table contains vertically
merged cells (requires some error handling).

For help on installing macros, see:
http://www.gmayor.com/installing_macro.htm

-- RegardsLene FredborgDocTools - Denmark

www.thedoctools.com

1. 04-21-2017, 06:26 AM #1

   Hi I'm hoping someone will be able to give me a quick answer for this as I don't think the problem is that complicated - I just can't see the solution. I have several iterations of the same table in a Word document (repeated on several different letters). Each cell in the first column contains a single bullet point - that's it. Nothing else. Each cell in the second column contains information by way of DocVariables which may or may not display a value. I have code from a previous document that deletes out the rows in a table if they are blank.

   Application.ScreenUpdating = False Dim Tbl As Table, cel As Cell, i As Long, n As Long, fEmpty As Boolean With ActiveDocument For Each Tbl In .Tables n = Tbl.Rows.Count For i = n To 1 Step -1 fEmpty = True For Each cel In Tbl.Rows(i).Cells If Len(cel.Range.Text) > 2 Then fEmpty = False Exit For End If Next cel If fEmpty = True Then Tbl.Rows(i).Delete Next i Next Tbl End With Set cel = Nothing: Set Tbl = Nothing Application.ScreenUpdating = True

   It isn't working this time however and I suspect it's because of the bulletpoint. Is there a way to tweak my code to ignore the initial column and delete the row if the cell in the second column is blank instead? Any help would be great. Thanks

   Dav

2. 04-21-2017, 06:52 AM #2

   How about

   Sub DeleteEmptyRows() Dim Tbl As Table, cel As Cell Dim i As Long, j As Long, n As Long, fEmpty As Boolean Application.ScreenUpdating = False With ActiveDocument For Each Tbl In .Tables n = Tbl.Rows.Count For i = n To 1 Step -1 fEmpty = True For j = 2 To Tbl.Rows(i).Cells.Count Set cel = Tbl.Rows(i).Cells(j) If Len(cel.Range.Text) > 2 Then fEmpty = False Exit For End If Next j If fEmpty = True Then Tbl.Rows(i).Delete Next i Next Tbl End With Set cel = Nothing: Set Tbl = Nothing Application.ScreenUpdating = True End Sub

   Graham Mayor - MS MVP (Word) 2002-2019 Visit my web site for more programming tips and ready made processes

   http://www.gmayor.com

3. 04-21-2017, 08:38 AM #3

   Hi Graham Thanks for your suggestion. I've run this through and I'm afraid it doesn't appear to delete out the rows, I'm still left with either one or two rows with a bulletpoint and no information beside it. Any other ideas? Thanks

   Dav

4. 04-21-2017, 08:28 PM #4

   It should work, and does here if the remaining cells in the row are all empty - a space in a cell will cause it to ignore the row. Click the ¶ button on the Home tab to display the formatting or if you cannot find the cause post a copy of the table that doesn't work as a document attachment.

   Graham Mayor - MS MVP (Word) 2002-2019 Visit my web site for more programming tips and ready made processes

   http://www.gmayor.com

5. 04-22-2017, 06:13 AM #5

   Try modifying this line: If Len(cel.Range.Text) > 2 Then to:

   If Len(Trim(cel.Range.Text)) > 2 Then

   Greg

   Visit my website: http://gregmaxey.com

6. 04-22-2017, 06:49 AM #6

   That should work for a space, but it won't for (say) a non-breaking space or a tab character. Without knowing what is in the cell, it is difficult to come up with a solution.

   Graham Mayor - MS MVP (Word) 2002-2019 Visit my web site for more programming tips and ready made processes

   http://www.gmayor.com

7. 04-22-2017, 07:19 AM #7

   Graham, True but just a bit bored and looking for something to do ;-). Perhaps:

   Sub DeleteEmptyRows() Dim Tbl As Table, cel As Cell Dim i As Long, j As Long, n As Long, fEmpty As Boolean Application.ScreenUpdating = False With ActiveDocument For Each Tbl In .Tables n = Tbl.Rows.Count For i = n To 1 Step -1 fEmpty = True For j = 2 To Tbl.Rows(i).Cells.Count Set cel = Tbl.Rows(i).Cells(j) If Not fcnJustWhiteSpace(cel) Then fEmpty = False Exit For End If Next j If fEmpty = True Then Tbl.Rows(i).Delete Next i Next Tbl End With Set cel = Nothing: Set Tbl = Nothing Application.ScreenUpdating = True End Sub Private Function fcnJustWhiteSpace(cel) As Boolean Dim oChr fcnJustWhiteSpace = True For Each oChr In cel.Range.Characters Select Case Asc(oChr) Case 9, 11, 13, 32, 160 Case Else: fcnJustWhiteSpace = False: Exit For End Select Next End Function

   Greg

   Visit my website: http://gregmaxey.com

8. 04-24-2017, 05:13 AM #8

   Hi Greg/Graham

   Thanks very much for the suggestion - changing the code to

   If Len(Trim(cel.Range.Text)) > 2 Then

   worked a charm. I'll mark this as solved and thanks again.

   Dav

9. 04-24-2017, 01:44 PM #9

   Good. Worked because some of the cells contained one or more spaces. If you try the other version it should take care of that plus any other "white space" i.e, tabs, linebreaks, etc.

   Greg

   Visit my website: http://gregmaxey.com