Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 09-30-2015, 04:35 AM
jc491's Avatar
jc491 jc491 is offline Windows 7 64bit Office 2013
VBA Novice
 
Join Date: Sep 2015
Location: UK
Posts: 55
jc491 is on a distinguished road
Default VBA Table Search All Tables - Find & Replace Text in Table Cell With Specific Background Color

Hi All,



I would like some help and advice on how to put this macro together.
I have searched the forum and not yet found a solution although I am sure a similar one exists.
My apologies if it's already been solved.

Situation:
I have many tables in a document.
I need to search ALL the Tables and find table cells that contain:
A specific back ground Color
Find and Replace text in that cell ONLY - e.g. % with CB

Code:
  Sub FindTableText()
     
   
  Dim aTable As Table, oCell As Cell
      For Each aTable In ActiveDocument.Tables
          For Each aCell In aTable.Range.Cells
   
  ' if background shading is a specific color
   
  Selection.Shading.BackgroundPatternColor = RGB( 63, 123, 196 )
   
   'Find text in the cell and replace 

  With Selection.Find
          .Text = "%"
          .Replacement.Text = " CB1"
          .Forward = True
          .Wrap = wdFindContinue
          .Format = False
          .MatchCase = False
          .MatchWholeWord = False
          .MatchWildcards = False
          .MatchSoundsLike = False
          .MatchAllWordForms = False
      End With
      Selection.Find.Execute Replace:=wdReplaceAll
   
   Next aCell
   
      Next aTable
      End Sub
I am not sure how to put this together.

If anyone can advise, I would be really grateful.

Many thanks for your time in advance
J
Reply With Quote
  #2  
Old 09-30-2015, 05:00 AM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,595
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
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "%"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    If .Information(wdWithInTable) = True Then
      If .Cells(1).Shading.BackgroundPatternColorIndex = wdGray50 Then .Text = "CB1"
    End If
    If .End = ActiveDocument.Range.End Then Exit Sub
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #3  
Old 09-30-2015, 05:08 AM
gmayor's Avatar
gmayor gmayor is offline Windows 7 64bit Office 2010 32bit
Expert
 
Join Date: Aug 2014
Posts: 3,829
gmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to behold
Default

It is probably quicker to look for the character than to step through each cell, then determine if it is in a table and if the cell it is in has the required shading.

Code:
Sub ReplaceInTable()
Dim orng As Range
    Set orng = ActiveDocument.Range
    With orng.Find
        Do While .Execute(FindText:="%")
            If orng.Information(wdWithInTable) Then
                If orng.Cells(1).Shading.BackgroundPatternColor = RGB(63, 123, 196) Then
                    orng.Text = " CB"
                    orng.Collapse 0
                End If
            End If
        Loop
    End With
lbl_Exit:
    Exit Sub
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #4  
Old 09-30-2015, 05:09 AM
gmayor's Avatar
gmayor gmayor is offline Windows 7 64bit Office 2010 32bit
Expert
 
Join Date: Aug 2014
Posts: 3,829
gmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to behold
Default

I see Paul was thinking along the same lines ... at the same time
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #5  
Old 09-30-2015, 05:15 AM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,595
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

Graham, the difference in posting times puts me about as far ahead as the time it takes light to travel from the sun to earth
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #6  
Old 09-30-2015, 05:56 AM
jc491's Avatar
jc491 jc491 is offline Windows 7 64bit Office 2013
VBA Novice
 
Join Date: Sep 2015
Location: UK
Posts: 55
jc491 is on a distinguished road
Default

Hi Paul,

this is great! thanks so much - exactly what I needed.

I don't know if word is being funny with me again.

However, when I change the shading color it does not respond

If .Cells(1).Shading.BackgroundPatternColorIndex = wdColorGray05

I was trying to make the cell Shading color light -so its not too strong.

Hence trying to use the RGB values - so I would be able to custom pick a light shade.

Am I doing something wrong with below?

If .Cells(1).Shading.BackgroundPatternColorIndex = wdColorGray05

Other than that its fantastic!
thank you

J
Reply With Quote
  #7  
Old 09-30-2015, 06:00 AM
jc491's Avatar
jc491 jc491 is offline Windows 7 64bit Office 2013
VBA Novice
 
Join Date: Sep 2015
Location: UK
Posts: 55
jc491 is on a distinguished road
Default

Hi Graham,
many thanks for your code, let me run it now

J
Reply With Quote
  #8  
Old 09-30-2015, 06:01 AM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,595
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

There is no such BackgroundPatternColorIndex constant as wdColorGray05 - only wdGray25 and wdGray50; otherwise you need to use RGB values like you originally had (i.e. BackgroundPatternColor = RGB( 63, 123, 196 )) or the BackgroundPatternColor constant wdColorGray05.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #9  
Old 09-30-2015, 06:10 AM
jc491's Avatar
jc491 jc491 is offline Windows 7 64bit Office 2013
VBA Novice
 
Join Date: Sep 2015
Location: UK
Posts: 55
jc491 is on a distinguished road
Default

Paul & Graham,

thank you so much for your time.

Paul's Code works great!

Grahams Code with the RGB - is an added bonus!


I can set the color of my cell backgrounds and only replace in those cells. normally word just find's and replaces in the whole document, which can be a nightmare if you are trying to preserve code outside of the tables.

Spoilt for choice now

Thank you Gentlemen for your time

J

PS - If admin can Mark as Solved
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Setting a particular table cell background color when an option button is selected in Word 2007 a888 Word VBA 11 03-25-2015 05:33 AM
Macro to search warning text style and replace the text color rohanrohith Word VBA 3 11-27-2014 01:08 PM
How to remove background color in a table that isn't there but is there? pintree3 Word 5 10-27-2014 10:23 AM
Word VBA Find Table Text Shading Colour and replace with another QA_Compliance_Advisor Word VBA 10 09-19-2014 08:36 AM
how to search and replace BOLD text >> font color change? dylansmith Word 4 03-12-2013 09:51 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 02:59 AM.


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