Help to spead up macro - Find and Replace in Tables, Cut Paste Next Cells

gmayor · #1 08-19-2019, 12:50 AM

If, as appears to be the case, the tables have an empty last column and the search relates to the next to last column, then it might be simpler and faster to process the columns e.g. using the macro below. It won't, however cater for merged cells or nested tables.

It would also be much quicker to run the process in Word 2010, but that's another story entirely.

Code:

Sub Macro1()
Dim i As Integer
Dim oTable As Table
Dim oRng As Range, oCell As Range
Dim sText As String
Dim lngCol As Long
    sText = InputBox("Enter text to move cell")
    Application.ScreenUpdating = False
    For Each oTable In ActiveDocument.Tables
        lngCol = oTable.Columns.Count
        For i = 1 To oTable.Rows.Count
            Set oRng = oTable.Cell(i, lngCol - 1).Range
            oRng.End = oRng.End - 1
            If InStr(1, oRng.Text, sText) > 0 Then
                Set oCell = oTable.Cell(i, lngCol).Range
                oCell.End = oCell.End - 1
                oCell.FormattedText = oRng.FormattedText
                oRng.Text = ""
            End If
            DoEvents
        Next i
        DoEvents
    Next oTable
    Application.ScreenUpdating = True
    MsgBox "Tables processed"
lbl_Exit:
    Set oTable = Nothing
    Set oRng = Nothing
    Set oCell = Nothing
    Exit Sub
End Sub

Cendrinne · #2 08-19-2019, 08:27 AM

GMayor,

What it did, it went to the last columns and in each cell that had the value ''$'' in it, moved completely the whole cell including the ''$'' to it's Right empty cell. And ignore all other columns.

In my test table (I only used tables of numbers, No text), I have 5 columns of numbers, and every columns has it's empty column besides, to enable to: Cut (the selected value, ...) ''$'', Move 1 Cell unit to the Right, and Paste (the selected value,...) ''$'', Loop to the end.

I just wish my macro I did, would do it all at once, versus, find and replace 1 value at the time.

I wish I could give an example of the test table. How can I insert without having to put a URL link?

Anyway, thanks and if you could think of something... I would be so grateful

I'll try the Guessed suggestion.

gmaxey · #3 08-19-2019, 04:22 PM

So your table has 10 columns odd have numbers with "$" and even are empty. Yes? Try:

Code:

Sub Macro1()
Dim lngIndex As Integer
Dim oTbl As Table
Dim oRng As Range
Dim strText As String
Dim lngCol As Long
Dim varVal
  strText = InputBox("Enter text to move cell")
  Application.ScreenUpdating = False
  For Each oTbl In ActiveDocument.Tables
    For lngCol = 1 To oTbl.Columns.Count - 1 Step 2
      For lngIndex = 1 To oTbl.Rows.Count
        Set oRng = oTbl.Cell(lngIndex, lngCol).Range
        oRng.End = oRng.End - 1
        varVal = Split(oRng.Text, strText)
        If UBound(varVal) = 1 Then
          oRng.Text = Trim(varVal(1))
          oRng.Cells(1).Next.Range.Text = strText
        End If
      Next lngIndex
      DoEvents
    Next lngCol
  Next oTbl
  Application.ScreenUpdating = True
  MsgBox "Tables processed"
lbl_Exit:
  Set oTbl = Nothing
  Set oRng = Nothing
  Exit Sub
End Sub

Cendrinne · #4 08-19-2019, 10:43 PM

OMG, You did it. Wow, wow, wow, you are a genius.
I've been trying for months, analyzing, trying, and I didn't come close to your result.

Thank you soooooo very much.

Most of our French documents are like that, if they have $ and %, we usually need to put them in a separate columns to have all the numbers aligned perfectly. And unlike in English, where the $ are in front of the numbers, our $ are in the back. So we put both the % and $ in the same columns and all the numbers can be aligned.

What a fantastic group of people here. I'm truly grateful

Have a super duper reste of the week

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
what method to find all cells paste linked to a certain cell ?	DBenz	Excel	1	06-28-2018 12:16 PM
Select Cell Text to paste into Find/Replace	CBarry	Word VBA	2	02-16-2017 04:37 AM
Find and Replace Macro	amparete13	PowerPoint	3	03-11-2014 05:29 AM
macro or find/replace	JamesVenhaus	Word	2	02-27-2012 03:34 PM
Find and Replace Macro - A Better Way	Tribos	Word VBA	0	10-08-2008 03:22 AM