#1
|
|||
|
|||
Delete all rows but the last.
Hi all,
First of, I'm not a VB/VBA programmer, I'm a sas programmer, so please forgive me if say something stupid. I wrote a simple macro in Word 2003 to remove all tables from a document. Code:
Sub Deltables() Application.ScreenUpdating = False Dim Tbl As Table With ActiveDocument For Each Tbl In .Tables Tbl.delete Next Tbl End With Application.ScreenUpdating = True End Sub Since the tables have different numbers of rows is there a way to do something like... If not tbl.last.row then delete Thanks in advance.. Last edited by macropod; 09-11-2012 at 04:26 PM. Reason: Added code tags & formatting |
#2
|
||||
|
||||
In that case, try:
Code:
Sub DelTableRows() Application.ScreenUpdating = False Dim Tbl As Table, i As Long With ActiveDocument For Each Tbl In .Tables For i = (Tbl.Rows.Count - 1) To 1 Step -1 Tbl.Rows(i).Delete Next Next Tbl End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Thank you for your help macropod. That work perfectly.
What would be the cleanest approach to copy the content of the last row and paste it into the body of the doc? Thanks again. |
#4
|
||||
|
||||
Quote:
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
Hi Macropod,
I actually don't need any tables in my docs. I only need the text in the last row since that is where the statistician puts the footnotes. What approach were you thinking of? |
#6
|
||||
|
||||
For example:
Code:
Sub ExtractTableNotes() Application.ScreenUpdating = False Dim i As Long With ActiveDocument For i = .Tables.Count To 1 Step -1 With .Tables(i) .Split .Rows.Count .Delete End With With .Tables(i) .Range.Characters.First.Previous.Delete .ConvertToText End With Next End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#7
|
|||
|
|||
That didn't seem to work. I get a Runtime Error: 'Object has been deleted' at this location:
Code:
.Split .Rows.Count Thank again. |
#8
|
||||
|
||||
I am unable to replicate that error. If you can provide some more info on the table the code falls over on (especially by including a copy of it in a document attached to a post), I might be able to do something.
Here's a minor enhancement to the code in case it encounters a one-row table: Code:
Sub ExtractTableNotes() Application.ScreenUpdating = False Dim i As Long With ActiveDocument For i = .Tables.Count To 1 Step -1 With .Tables(i) If .Rows.Count > 1 Then .Split .Rows.Count .Delete End If End With With .Tables(i) .Range.Characters.First.Previous.Delete .ConvertToText End With Next End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#9
|
|||
|
|||
Hi Macropod,
It is failing on tables that have a vertical merge. I didn't notice this before because the first few tables don't have a merged colunm or row. Then I noticed that the macro starts with the last table in the document, which does have a merged column. Does that help? Thanks again for your time. |
#10
|
||||
|
||||
Working with merged cells does make it difficult to process tables on a row-by-row basis. Try the following macro, which assumes the desired content is always in the table's last cell:
Code:
Sub ExtractTableNotes() Application.ScreenUpdating = False Dim i As Long, Rng As Range With ActiveDocument For i = .Tables.Count To 1 Step -1 Set Rng = .Tables(i).Range.Cells(.Tables(i).Range.Cells.Count).Range Rng.End = Rng.End - 1 Rng.InsertAfter vbCr Rng.Copy Set Rng = .Tables(i).Range Rng.Tables(1).Delete Rng.Paste Next End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#11
|
|||
|
|||
Macropod,
That works perfectly. Thank you for all your help. I was trying to understand what the code was doing so I could modify it but i don't understand how it is setting the focus to the last row. Is that what this is doing? Code:
Rng.End = Rng.End - 1 Code:
Rng.Tables(1).Delete Code:
if Tbl.Rows(1).??? = 'Listings' then ??.copy ??.paste end if Any ideas? Thanks again. |
#12
|
||||
|
||||
The 'Rng.End = Rng.End - 1' is used because, when you select a cell range, you get the end-of-cell marker, which you don't want when you're going to paste the content somewhere else. What the code does instead, is to insert a temporary paragraph break before that, so as to keep the cell's paragraph formatting for whatever is the cell's last paragraph, then copy everything except the end-of-cell marker.
Regarding the string, are you wanting to keep the table, or just the string? Is it a particular string? How many cells are on the first row?
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#13
|
|||
|
|||
Ok, thanks for the explanation.
The tables I want the first row from have one horizatially merged cell. I would need to check if the contents of the cell contains the word 'Listing.' If it does, the contents of the cell needs to be converted to text just like the last row. I have no need for the tables themselves. Does that help? Thanks again. |
#14
|
||||
|
||||
Try the following. As you can see, there's a lot more involved now.
Code:
Sub ExtractTableNotes() Application.ScreenUpdating = False Dim i As Long, Rng As Range With ActiveDocument For i = .Tables.Count To 1 Step -1 If i = 1 Then If .Tables(i).Range.Start = .Range.Start Then Set Rng = .Tables(i).Range With Rng .Tables(i).Range.Cut .InsertBefore vbCr .Collapse wdCollapseEnd .Paste End With End If End If Set Rng = .Tables(i).Range.Cells(1).Range If InStr(Rng.Text, "Listing") > 0 Then With Rng .End = .End - 1 .InsertAfter vbCr .Copy .Start = .Start - 1 .Collapse wdCollapseStart .InsertAfter vbCr .Collapse wdCollapseEnd .Paste .Characters.Last.Delete End With End If Set Rng = .Tables(i).Range.Cells(.Tables(i).Range.Cells.Count).Range With Rng .End = .End - 1 .InsertAfter vbCr .Copy End With Set Rng = .Tables(i).Range Rng.Tables(1).Delete Rng.Paste Next End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#15
|
|||
|
|||
This is working perfectly.
Thank you for all your help. |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Macro to delete all empty rows from all tables | braddgood | Word VBA | 15 | 10-02-2015 01:54 PM |
Macro to conditionally delete rows | Steve_D | Excel | 2 | 08-24-2012 09:37 PM |
Macro to delete rows with all empty cells | ubns | Excel Programming | 2 | 08-14-2012 02:01 AM |
merging rows and creating sub-rows | gib65 | Excel | 2 | 12-09-2011 02:09 PM |
delete email message via blackberry and have it delete on my pop3 and my outlook | Iamthestorm | Outlook | 2 | 10-28-2010 12:21 AM |