VBA Word - Find Formatted Text Version Only

jc491 · #1 01-05-2016, 11:36 AM

Hello to all,

this Tuesday. I hope every one is doing great today!

Thank you for all the help provided these previous past few days.

I have been using Graham's fantastic Replace from Table VBA Macro.

The code below - does a fantastic job. It searches and replaces all the text in column 1 - and replaces with text found in column 2.

I was hoping to simply extend the code.

I don't know if what I am asking for is possible?

As I have been fiddling about with it and have not been able to make heads or tails with the solution, nothing happens when I add new code on to it.

No doubt - I am doing it wrong

Is it possible to find the exact formatted text in column A of the table, ignoring all other types of formatting

Here is an example

http://tinypic.com/r/258cyf6/9

Code:

Sub ReplaceFromTableWithFormatting()


' Slightly Tweaked from Graham Mayor's TableReplace Function
' And  Doug Robbins 
' Bulk Find & Replace From Table
'

 Dim oChanges As Document, oDoc As Document
 Dim oTable As Table
 Dim oRng As Range
 Dim rFindText As Range, rReplacement As Range
 Dim i As Long
 Dim sFname As String
 
 '==================DOCUMENT LOCATION
 
 
   sFname = "C:\Users\Desktop\TableReplace.docx"

 
 Set oDoc = ActiveDocument
 Set oChanges = Documents.Open(FileName:=sFname, Visible:=False)
 Set oTable = oChanges.Tables(1)
 For i = 1 To oTable.Rows.Count
     Set oRng = oDoc.Range
     Set rFindText = oTable.Cell(i, 1).Range
     rFindText.End = rFindText.End - 1
     Set rReplacement = oTable.Cell(i, 2).Range
     rReplacement.End = rReplacement.End - 1
     Selection.HomeKey wdStory
     
    
       
       With oRng.Find
       
       
       ' Find only the exact formatted version as displayed in Column 1
       
       
            .Format = True       ' This may not be correct?
            .ClearFormatting
            .Replacement.ClearFormatting
            Do While .Execute(FindText:=rFindText, _
                              MatchWholeWord:=True, _
                              MatchWildcards:=False, _
                              Forward:=True, _
                              Wrap:=wdFindStop) = True
                oRng.Select
                oRng.FormattedText = rReplacement.FormattedText
                oRng.Collapse wdCollapseEnd
            Loop
        End With

           
       
 Next i
 oChanges.Close wdDoNotSaveChanges
 

End Sub

This table solution for me is such a great tool - if I could just abuse the kindness of an advanced practitioner to see if if it's possible to do the impossible (which it is to me at this moment) - that is find the exact formatted text.

I will not lie this is a complex task, what seems simple enough in theory is not when it comes to coding.

Thank you so very much for taking the time to look over this.

I really really do appreciate all the help from the great individuals here

I would be lost without the kind help

thank you

J

macropod · #2 01-05-2016, 06:38 PM

If you want to restrict the find to a particular font format, you need to specify those parameters. For example:

Code:

With oRng.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = rFindText
  With .Font
    .Bold = True
    .ColorIndex = wdTurquoise
    .Size = 16
  End With
  .Replacement.Text = ""
  .Forward = True
  .Wrap = wdFindStop
  .Format = True
  .MatchCase = True
  .MatchWholeWord = True
  .MatchWildcards = False
  .MatchSoundsLike = False
  .MatchAllWordForms = False
  .Execute
  Do While .Found = True
    .FormattedText = rReplacement.FormattedText
    .Collapse wdCollapseEnd
    .Execute
  Loop
End With

The important part of the above for your purposes is the setting of the font attributes (there are other attributes you could also set, including italic, underline, etc.) and '.Format = True'. You may or may not want to match the case, etc.

jc491 · #3 01-05-2016, 07:50 PM

Hello Paul,

thank you for helping again and for the code.

I see what you mean. I have to specify exactly what I am looking for.

In that case - is there a way for me to store all my individual code for each formatted text and then call it from this macro?

The current table is 2 columns. Is it possible for me to store this code in in a 3rd column so that this macro may be able to use that code.

I am just guessing at this as you know.

I find my self having to run dozens of macros for formatting and organisng these macros is becoming really really difficult.

Then I have to record macros every time I come across some new formatting.

I really love this table solution - everything is really transparent easy for me to see what needs replacing.

The table is really good at replacing formatted text, just not at finding the specific formatted text.

It would be super awesome - If I could find a way to organize all the code - so I can call it if needs be - or if you have any other better ideas - I am happy to try that.

Your thoughts greatly appreciated

thank you again

J

gmayor · #4 01-05-2016, 10:12 PM

It might be possible, provided all the text that you were looking for was formatted in the same way i.e if the text in column 1 of the table was formatted as 16 point bold Times New Roman, then that should be doable without the use of extra columns. Try the following (I have commented out the unnecessary lines):

Code:

Option Explicit

Sub ReplaceFromTableWithFormatting()


' Slightly Tweaked from Graham Mayor's TableReplace Function
' And  Doug Robbins
' Bulk Find & Replace From Table
'

Dim oChanges As Document, oDoc As Document
Dim oTable As Table
Dim oRng As Range
Dim rFindText As Range, rReplacement As Range
Dim i As Long
Dim sFname As String

    '==================DOCUMENT LOCATION


    sFname = "C:\Users\Desktop\TableReplace.docx"
    
    Set oDoc = ActiveDocument
    Set oChanges = Documents.Open(Filename:=sFname, Visible:=False)
    Set oTable = oChanges.Tables(1)
    For i = 1 To oTable.Rows.Count
        Set oRng = oDoc.Range
        Set rFindText = oTable.Cell(i, 1).Range
        rFindText.End = rFindText.End - 1
        Set rReplacement = oTable.Cell(i, 2).Range
        rReplacement.End = rReplacement.End - 1
        Selection.HomeKey wdStory

        With oRng.Find
            ' Find only the exact formatted version as displayed in Column 1
            '.Format = True        ' This may not be correct?
            '.ClearFormatting
            '.Replacement.ClearFormatting
            'set the variety of formats to look for
            .Font.Name = rFindText.Font.Name
            .Font.Bold = rFindText.Font.Bold
            .Font.Size = rFindText.Font.Size
            .Font.Italic = rFindText.Font.Italic
            .Font.Underline = rFindText.Font.Underline
            .Font.ColorIndex = rFindText.Font.ColorIndex
            
            Do While .Execute(FindText:=rFindText, _
                              MatchWholeWord:=True, _
                              MatchWildcards:=False, _
                              Forward:=True, _
                              Wrap:=wdFindStop) = True
'                oRng.Select
                oRng.FormattedText = rReplacement.FormattedText
                oRng.Collapse wdCollapseEnd
            Loop
        End With

    Next i
    oChanges.Close wdDoNotSaveChanges
End Sub

macropod · #5 01-06-2016, 12:13 AM

Once you start getting into variable Find/Replace parameters that might include wildcards and formatting, you should consider having a separate column for each of them. In that case, rather than using a Word table, I'd be inclined to use an Excel workbook. The following macro is designed around such an approach, with the:
• Find expression in Column A
• Replace expression in Column B
• Wildcard switch in Column C
• Format switch in Column D
• Find font formats in columns E-H
• Replace font formats in columns I-L
If the Format switch in Column D isn't set, none of the Find & Replace font formats will take effect.

Code:

Sub BulkFindReplaceWithParameters()
Application.ScreenUpdating = True
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, StrWkSht As String
Dim bStrt As Boolean, iDataRow As Long, bFound As Boolean, i As Long
Dim xlFExpr, xlRExpr, xlFWild, xlFFrmt, xlFBold, xlFItal, xlFUnln, xlFPnts, xlRBold, xlRItal, xlRUnln, xlRPnts
StrWkBkNm = "C:\Users\" & Environ("Username") & "\Documents\BulkFindReplace.xls"
StrWkSht = "Sheet1"
If Dir(StrWkBkNm) = "" Then
  MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
  Exit Sub
End If
' Test whether Excel is already running.
On Error Resume Next
bStrt = False ' Flag to record if we start Excel, so we can close it later.
Set xlApp = GetObject(, "Excel.Application")
'Start Excel if it isn't running
If xlApp Is Nothing Then
  Set xlApp = CreateObject("Excel.Application")
  If xlApp Is Nothing Then
    MsgBox "Can't start Excel.", vbExclamation
    Exit Sub
  End If
  ' Record that we've started Excel.
  bStrt = True
End If
On Error GoTo 0
'Check if the workbook is open.
bFound = False
With xlApp
  'Hide our Excel session
  If bStrt = True Then .Visible = False
  For Each xlWkBk In .Workbooks
    If xlWkBk.FullName = StrWkBkNm Then ' It's open
      Set xlWkBk = xlWkBk
      bFound = True
      Exit For
    End If
  Next
  ' If not open by the current user.
  If bFound = False Then
    ' Check if another user has it open.
    If IsFileLocked(StrWkBkNm) = True Then
      ' Report and exit if true
      MsgBox "The Excel workbook is in use." & vbCr & "Please try again later.", vbExclamation, "File in use"
      If bStrt = True Then .Quit
      Exit Sub
    End If
    ' The file is available, so open it.
    Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm)
    If xlWkBk Is Nothing Then
      MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
      If bStrt = True Then .Quit
      Exit Sub
    End If
  End If
  ' Process the workbook.
  With xlWkBk
      With .Worksheets(StrWkShtNm)
      ' Find the last-used row in column A.
      ' Add 1 to get the next row for data-entry.
      iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
      ' Get the Find/Replace parameters.
      For i = 2 To iDataRow
        ' Skip over empty fields to preserve the underlying cell contents.
        If Trim(.Range("A" & i)) <> vbNullString Then
          xlFExpr = xlFExpr & "|" & Trim(.Range("A" & i))
          xlRExpr = xlRExpr & "|" & Trim(.Range("B" & i))
          xlFWild = xlFWild & "|" & Trim(.Range("C" & i))
          xlFFrmt = xlFFrmt & "|" & Trim(.Range("D" & i))
          xlFBold = xlFBold & "|" & Trim(.Range("E" & i))
          xlFItal = xlFItal & "|" & Trim(.Range("F" & i))
          xlFUnln = xlFUnln & "|" & Trim(.Range("G" & i))
          xlFPnts = xlFPnts & "|" & Trim(.Range("H" & i))
          xlRBold = xlRBold & "|" & Trim(.Range("I" & i))
          xlRItal = xlRItal & "|" & Trim(.Range("J" & i))
          xlRUnln = xlRUnln & "|" & Trim(.Range("K" & i))
          xlRPnts = xlRPnts & "|" & Trim(.Range("L" & i))
        End If
      Next
    End With
    If bFound = False Then xlWkBk.Close False
    If bStrt = True Then .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
'Process each word from the F/R List
For i = 1 To UBound(Split(xlFExpr, "|"))
  With ActiveDocument.Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Format = CBool(Split(xlFFrmt, "|")(i))
      .MatchWildcards = False
      .MatchWholeWord = True
      .MatchCase = True
      If CBool(Split(xlFWild, "|")(i)) = True Then
        .MatchWildcards = True
        .MatchWholeWord = False
        .MatchCase = False
      End If
      With .Font
        If Split(xlFBold, "|")(i) <> "" Then .Bold = CBool(Split(xlFBold, "|")(i))
        If Split(xlFItal, "|")(i) <> "" Then .Italic = CBool(Split(xlFItal, "|")(i))
        If Split(xlFUnln, "|")(i) <> "" Then .Underline = CBool(Split(xlFUnln, "|")(i))
        If Split(xlFPnts, "|")(i) <> "" Then .Size = Split(xlFPnts, "|")(i)
      End With
      With .Replacement.Font
        If Split(xlRBold, "|")(i) <> "" Then .Bold = CBool(Split(xlRBold, "|")(i))
        If Split(xlRItal, "|")(i) <> "" Then .Italic = CBool(Split(xlRItal, "|")(i))
        If Split(xlRUnln, "|")(i) <> "" Then .Underline = CBool(Split(xlRUnln, "|")(i))
        If Split(xlRPnts, "|")(i) <> "" Then .Size = Split(xlRPnts, "|")(i)
      End With
      .Wrap = wdFindContinue
      .Text = Split(xlFExpr, "|")(i)
      .Replacement.Text = Split(xlRExpr, "|")(i)
      .Execute Replace:=wdReplaceAll
    End With
  End With
Next
ErrExit:
Application.ScreenUpdating = True
End Sub
 
Function IsFileLocked(strFileName As String) As Boolean
  On Error Resume Next
  Open strFileName For Binary Access Read Write Lock Read Write As #1
  Close #1
  IsFileLocked = Err.Number
  Err.Clear
End Function

jc491 · #6 01-06-2016, 08:41 AM

Paul and Graham,

Gentlemen thank you for your generous input and help

.

Graham the table did pick up the formatted version - So if i need to add on new font types, I need to add a new code block to the main code - I assume.

Paul thank you for coding the extra advanced spreadsheet version - I can see it is a lot of work thank you for taking the time out to do this.

Just a quick point

Am I setting up the workbook correctly

error popped up

.Format = CBool(Split(xlFFrmt, "|")(i))

I do believe this may be the answer to reducing all those individual macros, if I can lay it all out in one place as per the spread sheet or Graham's Table - save me from running macros individually like a conveyor belt

I'm also going to see if its possible to add a column for the font RGB color -

I have attached the workbook

Pardon my instruction reading skills again - I do tend to go at a snails pace

Thank you ever so much

Really indebted to you

J

macropod · #7 01-06-2016, 03:54 PM

Your worksheet should have headings in Row 1, like:
Find String|Replace String|WildCards|Format|Find Bold|Find Ital|Find U_Line|Find Size|Replace Bold|Replace Ital|Replace U_Line|Replace Size
You could add more columns for Find & Replace font colours, etc., too.
Other than the Find & Replace string and the font sizes (& colours if you use them), the WildCards & Format columns should contain TRUE or FALSE and, the font attributes, if Format is TRUE should have TRUE or FALSE for whichever attributes you want to use for the F/R process.

For the colours, the simplest approach is to use their integer values in a single column. To use RGB values, you'd need a separate column for each or additional code to parse a 9-digit RGB string from a single column.

jc491 · #8 01-06-2016, 04:36 PM

Hello Paul,

Hope you are doing great today!

thank you for the pointers.

I was just wondering, does the font need a name? I could not find a column for the font name.

I have attached the updated spreadsheet - I think its starting to look a bit better now.

For the RGB I would need to add the code below

Code:


Dim xlRGB

xlRGB = xlRGB & "|" & Trim(.Range("M" & i))


If Split(xlRGB, "|")(i) <> "" Then .Color = Split(xlRGB, "|")(i)


If Split(xlRRGB, "|")(i) <> "" Then .Size = Split(xlRRGB, "|")(i)

I managed to figure out the True / False bit - when I ran the VBA sadly it did not do anything - knowing me as usual - I probably don't have the correct font name as there was not a column for the font name, or am confusing things.

In the document I am testing it on -

The font is : Times New Roman Bold 16

I am really excited I can see the endless possibilities - but I need to get the spreadsheet working first -

Thank you for helping me again

J

macropod · #9 01-06-2016, 04:52 PM

Quote:

Originally Posted by jc491

I was just wondering, does the font need a name? I could not find a column for the font name.

If you want to use that as a parameter, yes.

Quote:

Originally Posted by jc491

For the RGB I would need to add the code below

Actually, you might need both a Find colour and a Replace colour. And, unless you're actually using RGB values, I'd not be inclined to use RGB as part of the variable's name - perhaps xlFClr & xlRClr would be more appropriate.

You also would NOT want:

Code:

If Split(xlRRGB, "|")(i) <> "" Then .Size = Split(xlRRGB, "|")(i)

jc491 · #10 01-06-2016, 05:33 PM

Hi Paul,

I have added some code to the epic spreadsheet VBA Module.

I have added the variables at the end.

Tried to Modify the lines to go with new variables

Code:

Sub ReplaceFromSpreadsheet()

' Replace From XL Spreadsheet
' Paul Edstein

Application.ScreenUpdating = True
Dim xlApp As Object, xlWkBk As Object, StrWkBkNm As String, StrWkSht As String
Dim bStrt As Boolean, iDataRow As Long, bFound As Boolean, i As Long
Dim xlFExpr, xlRExpr, xlFWild, xlFFrmt, xlFBold, xlFItal, xlFUnln, xlFPnts, xlRBold, xlRItal, xlRUnln, xlRPnts, xlFNa, xlRNa, xlFClr, xlRClr



StrWkBkNm = "C:\Users\" & Environ("Username") & "\Desktop\BulkFindReplace.xlsx"


StrWkSht = "Sheet1"


If Dir(StrWkBkNm) = "" Then
  MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
  Exit Sub
End If
' Test whether Excel is already running.
On Error Resume Next
bStrt = False ' Flag to record if we start Excel, so we can close it later.
Set xlApp = GetObject(, "Excel.Application")
'Start Excel if it isn't running
If xlApp Is Nothing Then
  Set xlApp = CreateObject("Excel.Application")
  If xlApp Is Nothing Then
    MsgBox "Can't start Excel.", vbExclamation
    Exit Sub
  End If
  ' Record that we've started Excel.
  bStrt = True
End If
On Error GoTo 0
'Check if the workbook is open.
bFound = False
With xlApp
  'Hide our Excel session
  If bStrt = True Then .Visible = False
  For Each xlWkBk In .Workbooks
    If xlWkBk.FullName = StrWkBkNm Then ' It's open
      Set xlWkBk = xlWkBk
      bFound = True
      Exit For
    End If
  Next
  ' If not open by the current user.
  If bFound = False Then
    ' Check if another user has it open.
    If IsFileLocked(StrWkBkNm) = True Then
      ' Report and exit if true
      MsgBox "The Excel workbook is in use." & vbCr & "Please try again later.", vbExclamation, "File in use"
      If bStrt = True Then .Quit
      Exit Sub
    End If
    ' The file is available, so open it.
    Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm)
    If xlWkBk Is Nothing Then
      MsgBox "Cannot open:" & vbCr & StrWkBkNm, vbExclamation
      If bStrt = True Then .Quit
      Exit Sub
    End If
  End If
  
  
  
  ' Process the workbook.
  With xlWkBk.Worksheets(StrWkSht)
    ' Find the last-used row in column A.
    ' Add 1 to get the next row for data-entry.
    iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row ' -4162 = xlUp
    ' Get the Find/Replace parameters.
    For i = 2 To iDataRow
    
    
      ' Skip over empty fields to preserve the underlying cell contents.
      If Trim(.Range("A" & i)) <> vbNullString Then
      
      
        xlFExpr = xlFExpr & "|" & Trim(.Range("A" & i))
        xlRExpr = xlRExpr & "|" & Trim(.Range("B" & i))
        xlFWild = xlFWild & "|" & Trim(.Range("C" & i))
        xlFFrmt = xlFFrmt & "|" & Trim(.Range("D" & i))
        
        
        ' =========  FIND FONT FORMATS
        
        
        xlFNa = xlFNa & "|" & Trim(.Range("E" & i))
        xlFClr = xlFClr & "|" & Trim(.Range("F" & i))
        xlFBold = xlFBold & "|" & Trim(.Range("G" & i))
        xlFItal = xlFItal & "|" & Trim(.Range("H" & i))
        xlFUnln = xlFUnln & "|" & Trim(.Range("I" & i))
        xlFPnts = xlFPnts & "|" & Trim(.Range("J" & i))
        
        
        ' ========= REPLACE FONT FORMATS
        
        xlRNa = xlRNa & "|" & Trim(.Range("K" & i))
        xlRClr = xlRClr & "|" & Trim(.Range("L" & i))
        xlRBold = xlRBold & "|" & Trim(.Range("M" & i))
        xlRItal = xlRItal & "|" & Trim(.Range("N" & i))
        xlRUnln = xlRUnln & "|" & Trim(.Range("O" & i))
        xlRPnts = xlRPnts & "|" & Trim(.Range("P" & i))
        
        
      End If
    Next
  End With
  If bFound = False Then xlWkBk.Close False
  If bStrt = True Then .Quit
End With
' Release Excel object memory
Set xlWkBk = Nothing: Set xlApp = Nothing


'Process each word from the F/R List


For i = 1 To UBound(Split(xlFExpr, "|"))
  With ActiveDocument.Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Format = CBool(Split(xlFFrmt, "|")(i))
      .MatchWildcards = False
      .MatchWholeWord = True
      .MatchCase = True
      If CBool(Split(xlFWild, "|")(i)) = True Then
        .MatchWildcards = True
        .MatchWholeWord = False
        .MatchCase = False
      End If
      
      
      
      With .Font
      
      '================== Is below Correct?
      
      
      
        If Split(xlFNa, "|")(i) <> "" Then .Name = Split(xlFNa, "|")(i)
        If Split(xlFClr, "|")(i) <> "" Then .Color = Split(xlClr, "|")(i)
        
        
        If Split(xlFBold, "|")(i) <> "" Then .Bold = CBool(Split(xlFBold, "|")(i))
        If Split(xlFItal, "|")(i) <> "" Then .Italic = CBool(Split(xlFItal, "|")(i))
        If Split(xlFUnln, "|")(i) <> "" Then .Underline = CBool(Split(xlFUnln, "|")(i))
        If Split(xlFPnts, "|")(i) <> "" Then .Size = Split(xlFPnts, "|")(i)
        
        
      End With
      
      
      
      With .Font
      
      '===================== Is this correct?
      
      
        If Split(xlRNa, "|")(i) <> "" Then .Name = Split(xlRNa, "|")(i)
        If Split(xlRClr, "|")(i) <> "" Then .Color = Split(xlRClr, "|")(i)
        
        
        If Split(xlRBold, "|")(i) <> "" Then .Bold = CBool(Split(xlRBold, "|")(i))
        If Split(xlRItal, "|")(i) <> "" Then .Italic = CBool(Split(xlRItal, "|")(i))
        If Split(xlRUnln, "|")(i) <> "" Then .Underline = CBool(Split(xlRUnln, "|")(i))
        If Split(xlRPnts, "|")(i) <> "" Then .Size = Split(xlRPnts, "|")(i)
      End With
      .Wrap = wdFindContinue
      .Text = Split(xlFExpr, "|")(i)
      .Replacement.Text = Split(xlRExpr, "|")(i)
      .Execute Replace:=wdReplaceAll
    End With
  End With
Next
Application.ScreenUpdating = True
End Sub
 
Function IsFileLocked(strFileName As String) As Boolean
  On Error Resume Next
  Open strFileName For Binary Access Read Write Lock Read Write As #1
  Close #1
  IsFileLocked = Err.Number
  Err.Clear
End Function

there is something wrong with the Color

If Split(xlFClr, "|")(i) <> "" Then .Color = Split(xlClr, "|")(i)

Attached V3 of spreadsheet.

Thank you for looking over this

J

macropod · #11 01-06-2016, 06:36 PM

As indicated in post #7, you can't just input the RGB values into a cell that way. You need to either input them as the number value of the colour, as a 9-digit number (which you could then parse mathematically into the R, G & B components), using code like:

Code:

If Split(xlFClr, "|")(i) <> "" Then .Color = RGB(INT(Split(xlClr, "|")/1000000), INT(Split(xlClr, "|")/1000000) mod 1000, Split(xlClr, "|") mod 1000)

or as a delimited string (which you could then parse via Split into the R, G & B components). You can't use commas as the delimiters, as Excel will start turning them into plain numbers, and adding spaces into the mix along with the commas still doesn't help with the parsing. I'd suggest inputting the R, G & B components as space-separated values (e.g. 127 127 127), which you could then process using code like:

Code:

If Split(xlFClr, "|")(i) <> "" Then .Color = RGB(Split(Split(xlClr, "|")(i), " ")(0), Split(Split(xlClr, "|")(i), " ")(1), Split(Split(xlClr, "|")(i), " ")(2))

jc491 · #12 01-06-2016, 07:15 PM

Hi Paul,

you did say to convert the RGB, slap on my wrist.

Saying that - I would not have been able to write that complex mathematical RGB conversion string, I apologize I know you are doing all the work.

Thank you for persevering with me!

Good news - No Errors on this attempt -

However - sadly nothing happens.

Come on spreadsheet don't fail on me now - Paul has gone to all this trouble to code you - a bit of anthropomorphism never hurts when in doubt - to get XL motivated.

Attached is sample document - with macro attached and the 2 testing data.

There is no error - it should simple do the job now - but nothing happens

any idea

thank you again soo much

J

macropod · #13 01-06-2016, 08:19 PM

Your second:
With .Font
should be:
With .Replacement.Font
and, despite appearances, the font colour is not black; it's 'Automatic', so you should leave the Find RGB values empty in the Excel workbook.

jc491 · #14 01-06-2016, 08:55 PM

Hi Paul

thank you so much for all the help!

This is beyond outstanding!

I am really speechless.

I have been in a deep despair at the documents I have to work with, formatting like its from the era of cave man, that is some one went overboard with their idea of styling text - like there is no tomorrow.

I have an editing nightmare on my hands.

Unfortunately I can't remove all the formatting - as its styled in blocks of content and it has to be dealt with individually - this is where the problem arises. Replace this font with that font and style etc etc.....

Now multiply that by a nice folder full of hundreds of docs - you can imagine the sheer delight I feel , when having to physically copy paste and replace text fonts and styles.
It also really exacerbates my RSI problem - so this is a life saver bar none!

If I could do a cartwheel I would.

I am so grateful you suggested and coded the epic spreadsheet VBA module.

Thank you also to Graham for his table - which I will still use, that is excellent and I will use for block tasks.

I hope Microsoft continue to recognize how much individuals like yourself contribute to making their products better.

I despair at the help materials on VBA on their site - How are people supposed to learn when they have nothing of value or substance - one sentence telling me what the word means is a circular reasoning fail.

Many of the pages have similar to below with no example

expression .End
expression A variable that represents a Range object.

That does not really tell me much now does it.

Paul you are the man. There is no way I could have done this at all!

Thank you you are a VBA STAR*****

Thank you so much for making my life and thousands of others who can use this better.

J

PS - I won’t forget all the help

Also - I will be back in the future - to ask you how to add on to it - not now though this is more than enough

Have a great week and week end!!

jc491 · #15 01-06-2016, 08:57 PM

As Always Solved!

Ps - I also forgot I had the bold set to = TRUE in the spread sheet when I was looking for normal , hence other reason it did not work.

There is so much to look out - I always stumble on the small details

Thanks again
J

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
VBA Table – Search All Tables - Find & Replace Text in Table Cell With Specific Background Color	jc491	Word VBA	8	09-30-2015 06:10 AM
Macro to keep formatted form fields after mail merge or replace text with formatted form fields	jer85	Word VBA	2	04-05-2015 10:00 PM
How can I paste text that's not formatted as a table into a new table?	WaltR	Word	2	10-11-2014 03:16 PM
Word VBA Find Table Text Shading Colour and replace with another	QA_Compliance_Advisor	Word VBA	10	09-19-2014 08:36 AM
Word VBA Macro to Find and Replace based on the Alt Text of an Image	bennymc	Word VBA	1	01-27-2014 04:23 PM