Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 02-07-2014, 12:14 AM
mrayncrental mrayncrental is offline Cut Text from one table cell to another Windows 7 64bit Cut Text from one table cell to another Office 2007
Novice
Cut Text from one table cell to another
 
Join Date: Feb 2014
Posts: 15
mrayncrental is on a distinguished road
Question 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
Reply With Quote
  #2  
Old 02-07-2014, 05:19 PM
macropod's Avatar
macropod macropod is offline Cut Text from one table cell to another Windows 7 32bit Cut Text from one table cell to another Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,953
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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
Note: As coded, the macro inserts manual line breaks between the entries. For paragraph breaks, change Chr(11) to vbCr.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #3  
Old 02-08-2014, 11:11 PM
macropod's Avatar
macropod macropod is offline Cut Text from one table cell to another Windows 7 32bit Cut Text from one table cell to another Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,953
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

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]
Reply With Quote
  #4  
Old 02-09-2014, 01:49 PM
mrayncrental mrayncrental is offline Cut Text from one table cell to another Windows 7 64bit Cut Text from one table cell to another Office 2007
Novice
Cut Text from one table cell to another
 
Join Date: Feb 2014
Posts: 15
mrayncrental is on a distinguished road
Talking 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
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Cut Text from one table cell to another 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
Cut Text from one table cell to another 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

Other Forums: Access Forums

All times are GMT -7. The time now is 11:32 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft