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

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #16  
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
Default

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

Code:
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
      DoEvents
    Next lngCol
  Next oTbl
  Application.ScreenUpdating = True
  MsgBox "Tables processed"
lbl_Exit:
  Set oTbl = Nothing
  Set oRng = Nothing
  Exit Sub
End Sub

__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
Reply

Tags
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.
MSOfficeForums.com is not affiliated with Microsoft