Solved

Unique word identification in excel documents

Posted on 2014-01-15
4
358 Views
Last Modified: 2014-01-16
I am looking for a macro that can take an excel spreadsheet and generate a text file containing a list of UNIQUE words used in the spreadsheet. Some spreadsheets can contain as many as 80,000 words....

Note: individual cells can have multiple words separated by spaces.

A sample input files is attached

Thank you!
OFX-2.1.1.txt
0
Comment
Question by:cyber-33
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
4 Comments
 
LVL 35

Expert Comment

by:[ fanpages ]
ID: 39784498
Hi,

Sorry, I'm confused by your attached file.

Is this a text file you wish to open in MS-Excel & then produce another text file containing the unique words, or is this the resultant file after the required process is complete?

Perhaps you could attach an example MS-Excel workbook instead, so that it is clear what is required.

Thanks.

BFN,

fp.
0
 
LVL 51

Accepted Solution

by:
Rgonzo1971 earned 500 total points
ID: 39784794
Hi,

pls try this

The macro will ask for the file and then process it and paste the result in the active sheet

Sub macro()

    Const wdDoNotSaveChanges = 0
    
    Set wdApp = CreateObject("Word.Application")
    Dim fd As Object
    Dim Dict As Object
    Set Dict = CreateObject("Scripting.Dictionary")

    Set fd = wdApp.FileDialog(msoFileDialogOpen)
    With fd
        .Filters.Clear
        .Filters.Add "text (*.txt)", "*.txt"
        Result = .Show
        If Result = False Then Exit Sub
        Set wdDoc = wdApp.Documents.Open(Filename:=.SelectedItems(1))
    End With
    
    For Each aword In wdDoc.Words
        SingleWord = Trim(LCase(aword))
        If Not (Left(SingleWord, 1) < "a") And Not (Left(SingleWord, 1) > "z") Then
            If Not Dict.Exists(SingleWord) Then
                Dict.Add SingleWord, SingleWord
            End If
            
        End If
    Next
    wdDoc.Close wdDoNotSaveChanges
    WordList = Dict.Items
    ActiveSheet.Range("A1").Value = "Word List"
    For Idx = 0 To Dict.Count - 1
        s = WordList(Idx)
        ActiveSheet.Range("A1").Offset(Idx + 1).Value = WordList(Idx)
    Next
    
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range(Range("A2"), Range("A2").End(xlDown)), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range(Range("A1"), Range("A1").End(xlDown))
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    MsgBox "Done"
    
    Set wdApp = Nothing
    Set Dict = Nothing


End Sub

Open in new window

Regards
0
 

Author Closing Comment

by:cyber-33
ID: 39787017
Thank you!
0
 
LVL 35

Expert Comment

by:[ fanpages ]
ID: 39787308
You're welcome.
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
This article describes a serious pitfall that can happen when deleting shapes using VBA.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

729 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question