• Status: Solved
  • Priority: High
  • Security: Private
  • Views: 61
  • Last Modified:

Extract the data based on text colour

Hi Team,

I just wanted to find the way to solve the below problem using VBA.

I have 100+workbook where cross reference to other workpapers are given in red colour. I need to extract all of them in to one master list. Is it possible.

Source files are in work and excel.
0
Veena Raju
Asked:
Veena Raju
  • 10
  • 8
  • 3
1 Solution
 
Roy CoxGroup Finance ManagerCommented:
Source files are in work and excel

Do you mean Word & Excel?

A bit more information on data layout is needed
0
 
Veena RajuAuthor Commented:
Yeah the source files are in word and excel . Basically we have trade report from the vendor, which need to be cross refered to different transaction reports on the agreement. So in word the agreement will have reference to other files in Red colour. Same way in excel workbook.

Some vendor provides workpaper in word and some in excel. However, the constant thing in all file is the references are highlighted on Red colour. So i need a VBA to extract those references.

The difficult part is, they dont maintain constant naming convention. So am thinking text colour is same, so can do something with that.

In the attached file, I should extract all the sentence that are highlighted in red

Due to confidentiality, I cant share the file but example is attached.
Model-agreemtn.docx
0
 
Roy CoxGroup Finance ManagerCommented:
Working from Word and Excel makes the process more difficult. What are the Excel files like?

What do you expect the finished result to look like? It will be very difficult to organise the data.
0
Cloud Class® Course: Ruby Fundamentals

This course will introduce you to Ruby, as well as teach you about classes, methods, variables, data structures, loops, enumerable methods, and finishing touches.

 
Veena RajuAuthor Commented:
The final file should have


File Name        File type      File reference
MC agreement      xls             TK transaction report
MC agreement      xls      MK Mony report
MC agreement      xls      SM stanley report
LKC agreement      doc      HMG report
LKC agreement      doc      MSFD transaction report
LKC agreement      doc      To be verified
0
 
Veena RajuAuthor Commented:
Even if I have seperate VBA for both word and excel should be fine. but only request I have is, I should able to rn this on all excel/ word files on the particular folder at once.
0
 
aikimarkCommented:
Here is the Red Text extraction for Word documents:
Option Explicit

Sub DriveGetWordRedText()
    Dim oFS As Object
    Dim colResult As Collection
    Dim vItem As Variant
    
    Set oFS = CreateObject("scripting.filesystemobject")
    Set colResult = GetWordRedText(ActiveDocument)
    
    For Each vItem In colResult
        Debug.Print oFS.getbasename(ActiveDocument.Name), oFS.getextensionname(ActiveDocument.Name), vItem
    Next
End Sub

Public Function GetWordRedText(parmDocument As Document) As Collection
    Dim fnd As Find
    Dim bResult As Boolean
    Dim lngStart As Long
    Dim lngEnd As Long
    Dim strFoundText As String
    Static oRE As Object
    
    If oRE Is Nothing Then
        Set oRE = CreateObject("vbscript.regexp")
        oRE.Global = True
        oRE.Pattern = "\s*$"
    End If
    
    Set GetWordRedText = New Collection
    
    Set fnd = parmDocument.Range.Find
    fnd.ClearFormatting
    Do
        fnd.Font.Color = wdColorRed
        bResult = fnd.Execute(findtext:="*", MatchWildcards:=True, Format:=True)
        If bResult Then
        Else
            Exit Do
        End If
        
        lngStart = fnd.Parent.Start
        fnd.Font.Color = wdColorAutomatic
        bResult = fnd.Execute(findtext:="*", MatchWildcards:=True, Format:=True)
        lngEnd = fnd.Parent.Start
        'Debug.Print bResult, fnd.Parent.Start
        strFoundText = ActiveDocument.Range(lngStart, lngEnd)
        strFoundText = oRE.Replace(strFoundText, vbNullString)
        'Debug.Print Len(strFoundText), strFoundText   'ActiveDocument.Range(lngStart, lngEnd)
        GetWordRedText.Add strFoundText
    Loop Until bResult = False
End Function

Open in new window

0
 
Veena RajuAuthor Commented:
Hi,

Thank you so much. But unfortunately the above code is not working. Its not showing any result or output.
0
 
aikimarkCommented:
Press Ctrl+G after running the code
0
 
Veena RajuAuthor Commented:
Sorry it just gives me the below. Sorry if my message was not clear -

I need a list of text/sentences that are highlighted in red. Like my out put file should contain :

Book1 - (red colour text<Goodstransactionmanager>)
Book1 - Managerof the task
Book2-Transaction report

Book1/2 - Is the file reference
sentence - which are highlighted in red
0
 
aikimarkCommented:
Earlier you wrote:

File Name        File type      File reference
MC agreement      xls             TK transaction report
MC agreement      xls      MK Mony report
MC agreement      xls      SM stanley report
LKC agreement      doc      HMG report
LKC agreement      doc      MSFD transaction report
LKC agreement      doc      To be verified
Has that changed?

Do you realize that I only addressed the Word document part of your problem?
0
 
Roy CoxGroup Finance ManagerCommented:
I believe you will need more fields in your excel workbook and an example of the xls files you have would help
0
 
Veena RajuAuthor Commented:
Hi Aiki,

Yes my requirement has not changed. However, I need the macro to be run on particular folder, where all word documents are stored and the output as mentioned on above comment should be in one new excel sheet.

in the below format :

File Name        File type      File reference
LKC agreement      doc      HMG report
LKC agreement      doc      MSFD transaction report
LKC agreement      doc      To be verified
0
 
aikimarkCommented:
What did you see in the Immediate Window after running my code?
0
 
Veena RajuAuthor Commented:
I have attached both my word file and image after running the macro.

Basically the macro is giving me the complete sentence, where in I just need the text in Red and most importantly

1. I need the out put in the seperate/new excel sheet on above said format.
2. The macro should run on all files in particular folder. so when i run macro it should popup with dialogue box to select the folder and run in one shot.

but that code is excellent . only few changes to match my requirement.
saddddd.PNG
Often.docx
0
 
aikimarkCommented:
Ok.  The non-red font color with this document is different than the original document you posted.  It isn't black and it isn't automatic.
?selection.Font.Color
 3289650 
?wdColorBlack
 0 
?wdColorAutomatic
-16777216 

Open in new window

0
 
aikimarkCommented:
This is one of the reasons why I posted a partial solution.  I'm used to nonrepresentational sample files.
0
 
aikimarkCommented:
Please test this
Option Explicit

Sub DriveGetWordRedText()
    Dim oFS As Object
    Dim colResult As Collection
    Dim vItem As Variant
    
    Set oFS = CreateObject("scripting.filesystemobject")
    Set colResult = GetWordRedText(ActiveDocument)
    
    For Each vItem In colResult
        Debug.Print oFS.getbasename(ActiveDocument.Name), oFS.getextensionname(ActiveDocument.Name), vItem
    Next
End Sub

Sub ExtendSelectionThroughRed(parmSelection)
    'add words until we encounter non-red
    Do
        parmSelection.MoveEnd wdWord, 1
    Loop Until parmSelection.Characters.Last.Font.Color <> vbRed
    'back off until we get red
    Do
        parmSelection.MoveEnd wdCharacter, -1
    Loop Until parmSelection.Characters.Last.Font.Color = vbRed
End Sub

Public Function GetWordRedText(parmDocument As Document) As Collection
    Dim fnd As Find
    Dim bResult As Boolean
    Dim lngStart As Long
    Dim lngEnd As Long
    Dim strFoundText As String
    Static oRE As Object
    
    If oRE Is Nothing Then
        Set oRE = CreateObject("vbscript.regexp")
        oRE.Global = True
        oRE.Pattern = "\s*$"
    End If
    
    Set GetWordRedText = New Collection
    
    Set fnd = parmDocument.Range.Find
    fnd.ClearFormatting
    Do
        fnd.Font.Color = wdColorRed
        bResult = fnd.Execute(findtext:="?", MatchWildcards:=True, Format:=True)
        
        If bResult Then
        Else
            Exit Do
        End If
        
        ExtendSelectionThroughRed fnd.Parent
        GetWordRedText.Add fnd.Parent.Text
        
        fnd.Parent.Start = fnd.Parent.End + 1
    Loop Until bResult = False
End Function

Open in new window

0
 
Veena RajuAuthor Commented:
it works fine, thank a lot. But I need the output in the seperate excel file, that visible in VBA screen (when i do Ctsl+G)
0
 
aikimarkCommented:
please upload one or more workbooks that are representative of the data.
0
 
aikimarkCommented:
@Veena

Are you still participating in this question thread?
0
 
aikimarkCommented:
solution for Word documents
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: C++ 11 Fundamentals

This course will introduce you to C++ 11 and teach you about syntax fundamentals.

  • 10
  • 8
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now