#1
|
|||
|
|||
Cut Text from one table cell to another
Hi - I am trying to cut text that is in brackets ([text]) from one table cell to another table cell - move all words in brackets from column 3 to column 2.
The macro below works fine ---but if the original cell has 2 sets of bracketed words (e.g. [Set A], [Set B]) then when the text is pasted in the new cell, it overwrites whatever is already in the cell (only end up with [Set B] instead of [Set A] and [Set B]) Instead, I would like to add the pasted text on a new line in the cell with a blank line in between. Any suggestions???? Code:
Dim keepSearch As Boolean Dim Count As Integer ActiveDocument.Tables(1).Select Do Selection.Tables(1).Columns(3).Select With Selection.Find .ClearFormatting .Text = "[" .Replacement.ClearFormatting .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Execute End With If Selection.Find.Found Then Selection.Extend keepSearch = True ' find second quote of this pair With Selection.Find .ClearFormatting .Text = "]" .Replacement.ClearFormatting .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Execute End With 'Move selected text to column left Selection.Cut Selection.MoveLeft Unit:=wdCell Selection.PasteAndFormat (wdPasteDefault) Selection.MoveRight Unit:=wdCell Else keepSearch = False End If Loop While keepSearch |
#2
|
||||
|
||||
Try:
Code:
Sub Demo() Application.ScreenUpdating = False Dim Rng As Range With ActiveDocument.Tables(1).Range With .Find .ClearFormatting .Replacement.ClearFormatting .Text = "\[*\]" .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = False .MatchWildcards = True .Execute End With Do While .Find.Found If .InRange(ActiveDocument.Tables(1).Range) Then If .Cells(1).ColumnIndex = 3 Then .Cut Set Rng = .Cells(1).Previous.Range With Rng .End = .End - 1 If Len(.Text) > 0 Then .InsertAfter Chr(11) .Collapse wdCollapseEnd .Paste End With End If .Find.Execute Else Exit Do End If Loop End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
||||
|
||||
Cross-posted at: http://windowssecrets.com/forums/sho...ut-overwriting
For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#4
|
|||
|
|||
Solved
This worked perfectly and is more efficient. Added 2 minor tweaks:
- Some of my cells have more than one set of [] words, so I subtracted the row number to research the cell again if first set is found - Added additional row return Code:
Sub 1() ' ' Macro to take any [] words from column 3 and move to column 2, ' then search and replace to remove the brackets ' Dim rng As Range, rng2 As Range, sText As String Dim aTbl As Table, iRow As Integer, aCell As Cell Set aTbl = ActiveDocument.Tables(1) Set rng = aTbl.Range For iRow = 1 To aTbl.Rows.Count Set rng = aTbl.Cell(iRow, 3).Range With rng.Find .ClearFormatting .Text = "\[*\]" .MatchWildcards = True If .Execute = True Then sText = Replace(rng.Text, "[", "") sText = Replace(sText, "]", "") Set rng2 = aTbl.Cell(iRow, 2).Range If Len(rng2.Text) > 2 Then rng2.MoveEnd Unit:=wdCharacter, Count:=-1 rng2.Collapse Direction:=wdCollapseEnd rng2.Text = vbCr & vbCr & sText Else rng2.Text = sText End If rng.Delete ' Don't advance cell unless no brackets found iRow = iRow - 1 End If End With Next iRow End Sub |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Can I create a single-cell table that moves with the text? | lcaretto | Word Tables | 7 | 11-01-2013 06:04 AM |
Enter text into next available cell in a table | molesy | Word VBA | 2 | 09-11-2013 02:25 AM |
Text Form Fields - Filling the table cell | simville02 | Word Tables | 1 | 01-31-2013 11:12 PM |
Text Wrapping on Fixed Lines in a Form field/Table cell | okrmjr | Word Tables | 0 | 10-30-2009 08:52 AM |
Auto-populate an MS Word table cell with text from a diff cell? | dreamrthts | Word Tables | 0 | 03-20-2009 01:49 PM |