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

Go Back   Microsoft Office Forums > >

Thread Tools Display Modes
Old 08-20-2019, 04:00 PM
gmaxey gmaxey is offline Help to spead up macro - Find and Replace in Tables, Cut Paste Next Cells Windows 10 Help to spead up macro - Find and Replace in Tables, Cut Paste Next Cells Office 2016
Word MVP 2003-2009
Join Date: May 2010
Location: Marble, NC
Posts: 942
gmaxey will become famous soon enoughgmaxey will become famous soon enough

Just for the stake of expanding what seems to work. This version auto processes $ and % plus a few others:

Sub Macro1()
Dim oTbl As Table
Dim oRng As Range
Dim strText As String
Dim lngCol As Long, lngRow As Long, lngIndex As Long
Dim varVal
Dim varSyms
  'Auto processes Dollar sign, percent sign, euro, pound sterling, and yen
  strText = "$:%:" & ChrW(8364) & ":" & ChrW(163) & ":" & ChrW(165) 'InputBox("Enter the symbols separated with colon, eg. $:%", "SYMBOLS", "$:%")
  Application.ScreenUpdating = False
  varSyms = Split(strText, ":")
  For Each oTbl In ActiveDocument.Tables
    For lngCol = 1 To oTbl.Columns.Count - 1 Step 2
      For lngRow = 1 To oTbl.Rows.Count
        Set oRng = oTbl.Cell(lngRow, lngCol).Range
        oRng.End = oRng.End - 1
        For lngIndex = 0 To UBound(varSyms)
          varVal = Split(oRng.Text, varSyms(lngIndex))
          If UBound(varVal) = 1 Then
            Select Case True
              Case Trim(varVal(0)) <> vbNullString And Trim(varVal(1)) <> vbNullString
                'Where the symbol splits two numerical values.
                oRng.Text = Trim(varVal(0)) & "." & Trim(varVal(1))
              Case Trim(varVal(0)) <> vbNullString
                'Where the symbol follows the numerical value.
                oRng.Text = Trim(varVal(0))
              Case Else
                'Where the symbol precedes the numerical value.
                oRng.Text = Trim(varVal(1))
            End Select
            oRng.Cells(1).Next.Range.Text = varSyms(lngIndex)
          End If
        Next lngIndex
      Next lngRow
    Next lngCol
  Next oTbl
  Application.ScreenUpdating = True
  MsgBox "Tables processed"
  Set oTbl = Nothing
  Set oRng = Nothing
  Exit Sub
End Sub

Greg Maxey
Please visit my web site at
Reply With Quote

find & replace, help please, speed

Thread Tools
Display Modes

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
Help to spead up macro - Find and Replace in Tables, Cut Paste Next Cells 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

All times are GMT -7. The time now is 05:19 AM.

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