View Single Post
 
Old 03-04-2023, 08:04 PM
bblelli bblelli is offline Windows 10 Office 2021
Novice
 
Join Date: Feb 2023
Posts: 22
bblelli is on a distinguished road
Angry Find the content by color and copy it

Dears,

I'm trying to create a macro that search for every text written in purple color and
everytime the macro finds this red text, the macro should copy this paragrah and the next one.

Let's suppose that I have the following text:

Add Value. Something many self-made wealthy people have in common is that they are valuable in specific ways. ...
Tax Yourself. The concept of saving money is not a new one. ...
Create a Plan and Follow It. ...
Invest. ...
Start a Business. ...
Be Grateful. ...
Develop Patience. ...

In this case, I would like to have another word document with the following content:
Tax Yourself. The concept of saving money is not a new one. ...
Create a Plan and Follow It. ...

How can I do that?

I'm trying to work with the following code, wchich is working and returning just the first line, not the second one.

Code:
Option Explicit

Sub CopyRedText()
    Dim oTarget As Document
    Dim oDoc As Document
    Dim oRng As Range, oEnd As Range, oOriginal As Range
    Set oDoc = ActiveDocument
    Set oTarget = Documents.Add
    Set oRng = oDoc.Range
    Set oOriginal = oDoc.Range
    Set oEnd = oTarget.Range
    oOriginal.Collapse 0
    With oRng.Find
    .Font.Color = RGB(112, 48, 160)
    
        Do While .Execute
            If oRng.Start >= oOriginal.Start Then GoTo lbl_Exit
            oEnd.Collapse 0
            

            oEnd.FormattedText = oRng.FormattedText

            
            oEnd.Collapse 0
            oEnd.Collapse 1
            oEnd.InsertParagraphAfter
            oEnd.End = oTarget.Range.End
            'oRng.Text = ""
            'oRng.Collapse 0
        Loop
    End With
    oTarget.Activate
lbl_Exit:
    Exit Sub
End Sub
Thanks
Reply With Quote