Solved: Code to Delete Empty Rows in a Word Table

[mvesaas]

I need to delete empty cells in a table in a word doc. I have a table in a
word document that has 5 columns. The top 13 rows are
descriptive, and need to stay there no matter what. The bottom rows have
information that varies. Total rows in the table is 40. Each column, represents a different group of information, and I want to delete the empty cells in each row, so that the data in each column isnt scatted over the 40 rows. How do I do this, any ideas? I have tried various codes, but can't seem to get it to work.

[MOS MASTER]

Hi and welcome to VBAX! :hi:

I'm not clear on the question so I give you some back:


Is it empty rows you want to delete? (Meaning all cells on one row are tested for empty...if empty then delete row)
Or do you have some empty cells in your table that you want to get rid of?
Question 1 is easy to answer.

Question 2 would be harder because you're changing the cells layout and have to shift cells up.

If it is question 2 then please provide a document with a sample table the way it is and another table on page 2 in the way you want it to look after running the code.

HTH, :whistle:

[mvesaas]

Thanks for getting back so quickly, I have been reading VBA express for at least a year, but this is the first problem I could not find an answer to out on the forum.

Okay, I am trying to delete any cells in the column that have no data, when I do it manually, I "Delete Cells", and Shift Cells up. I am trying to attach a sample of the table before and after I have adjusted the columns, but I am not sure how to get the table to look clear enough as a jpeg. And still be a small enough file to upload. Have a suggestion? :dunno

[MOS MASTER]

Hi, :yes

No problem.

I was not thinking of a JPEG but more of a normal Word table so I can use that for a test.

So just make a Word document with some test date how it must look before and after.

When you answer a question and scroll down you see a button manage attachments which you can use to upload the file. (Prefer zipp file)

I'll code a sollution in the meanwhile to test. :whistle:

[mvesaas]

:giggle Okay, sorry, didnt see the ZIP file option when I was trying to upload, thought it had to be a pic file.

See attached. Again, thanks for your help!

[MOS MASTER]

No Problem

On it! :yes

[MOS MASTER]

Okay this is a bit more work then I thought.

In the upper part of the table a lot of empty cells have to stay you didn't mention that.

So I'll try to make it that you put the cursor in the row you want to delete the cells and have them deleted downwards like in your example. :yes

[mvesaas]

Yeah, I knew that the empty cells might be a problem, but there are a few options I have thought of to avoid this.

1) I can put invisible text in them (white on white), so the veiwer never sees them, but they are there so the code doesnt delete them.

2) Also I can create a bookmark, and write some code to start me at that bookmark.

3) Or write code to GO TO or FIND the specific text at the top of the table that doesnt change.

So getting the cursor in the right place isnt the tough part.

Some background on this project, it is a complex mail merge macro, that merges three times with three different data sources, and ALOT of "IF, then" language. So far this is the only formatting I havent been able to "sneak around." :hi:

[MOS MASTER]

Ok. I found another problem.

Some cells look empty but if you look close enough they have spaces in them. Thank god for the Trim function to get rid of those!

I must admit I don't have to much time so I did it not in the most effecient way. And these tables are hard to work on cause they have very much cells packed together.

This code works.
Option Explicit
Sub ActiveTableDeleteCells()
Dim oCell As Word.Cell
Dim iStart As Integer
Application.ScreenUpdating = False
With Selection
If .Information(wdWithInTable) Then
iStart = .Cells(1).Row.Index

For Each oCell In .Tables(1).Range.Cells
If oCell.Row.Index >= iStart Then
If Len(Trim(oCell.Range.Text)) = 2 Then
oCell.Delete ShiftCells:=wdDeleteCellsShiftUp
End If
End If
Next
End If
End With
End Sub


Just open the attachment.
Put the cursor in the cell: COVERAGES

Press ALT+F8 and run the sub.

HTH, :whistle:

[mvesaas]

:clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap:

IT WORKS! This is a great code.

So if I am understanding in a general way, it is going through to see if the cell is blank (ie. Len(Trim(oCell.Range.Text)) = 2), then if that is true, it deletes the cell, and shifts it upwards.

I really appreciate your help! I have finally finished this project, thanks to you!

:beerchug:

[MOS MASTER]

:clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap:

IT WORKS! This is a great code.

Glad to see you that happy!

You're most welcome! :beerchug: (To be honest the code could be better in speed!)



So if I am understanding in a general way, it is going through to see if the cell is blank (ie. Len(Trim(oCell.Range.Text)) = 2), then if that is true, it deletes the cell, and shifts it upwards.


Yes normally you can check for length of 2 in cell (End of cell marker)
But it's more save to take in account spaces as well with the Trim function.

So your assumption is correct! :yes

Glad to here you've finished your project...that's always a conquest of it's own and the feeling is great when you've finished something!

Let's say till the next challenge!

Tada...:whistle:

[mvesaas]

:dunno FOLLOW UP ISSUE:

Please help! In regards to this code, I am having a time problem once I get the entire project put together. In my document, I need to run this code on three different tables.

The program I have written includes macros that mail merge a word doc 3 times from diff data sources, then begins to FORMAT the final word doc depending on the info merged. One of the final things I am trying to do is to delete many of the empty cells in 3 tables to make it totally formatted so that the user doesnt have to do it manually before sending to a client.

2 of the tables are pretty large (39 rows, 5 columns), and it can take up to :eek: 10 minutes to complete the code!! Also, because it is taking so long, sometimes WORD is erroring out, and shutting down in the middle.

See code on previous reply.

:think: Any ideas on how to make this more efficient???

[MOS MASTER]

Hi M, :yes

Yes I know a way to speed up this code. But I have been busy this week so have to catch up on other things first.

I'm sure I'll post something this weekend. (If someone isn't first that is) :whistle:

[MOS MASTER]

Hi M, :yes

I've changed the code only to examine those cells that are between the bookmark (BmTable) and the end of the table.

The speed has increased dramaticaly. Old version took: 8 seconds to run..new version runs in 1,5 seconds!!!!

The code:
Option Explicit
Sub ActiveTableDeleteEmptyCells()
Dim oTable As Word.Table
Dim oCell As Word.Cell
Dim iCell As Integer
Dim iRow As Integer
Dim iCol As Integer
Application.ScreenUpdating = False

Set oTable = ActiveDocument.Bookmarks("bmTable").Range.Tables(1)
iCell = ActiveDocument.Bookmarks("bmTable").Range.Cells(1).Row.Index

With oTable
For iRow = .Rows.Count To iCell Step -1
For iCol = 1 To .Columns.Count
Set oCell = .Cell(iRow, iCol)
If Len(Trim(oCell.Range.Text)) = 2 Then
oCell.Delete Shiftcells:=wdDeleteCellsShiftUp
End If
Next
Next
End With

Set oCell = Nothing
Set oTable = Nothing
End Sub


Enjoy! :whistle:

[mvesaas]

Joost,

I am still working on tweaking this code. :rotlaugh: The code to delete empty cells in a table in word is working on its own. BUT when I have placed it into my project, it slows waaaay down. (10 mins to complete, if Word doesnt error out.)

I am not sure what is causing the problem, but I need to run this code on 3 different tables. It is also a mail merge document, so that may also be the problem.

The easiest fix I can find is to run all of my code first, then SAVE the document, then run the "delete empty cells" code. This seems to run much faster. I can format all three tables in about 30 seconds. Which isnt light speed, but it works! :yes Better then 10 minutes!

Right now there still seems to be a disconnect, because my doc is erroring out word during the save/close process, I am working on fixing it.

I will post an update once I have it worked out. Thanks again for all your help! :friends:

[mvesaas]

All right, looks like I figured it out. The code runs just fine once I have saved the document first, then run the formatting code to delete empty cells.

Thanks for all your assistance! :bow:

[MOS MASTER]

You're most welcome M! :beerchug: