Need help with modifying VBA code

Your macro was not included with the document. Can you please post it here?

Flyster

Flyster:

My apologies... it was my mistake.   I thought it would have included the code (that I had added to the Word document).

Anyhow, please find attached text file which contains 3 functions:
1. Sub Extract_Acronyms_to_Excel()
2. Sub AutomateExcel()
3. Sub ExtractAllAcronymsToNewDocument()

... where # 3 is the function that successfully imports acronyms into a new document.

Not sure if #1 and #2 can be (or should be) combined.   For right now, unless it's causing a problem, let's leave them separate.  

So, whatever code is working for the Word function, I'd like to also have in the two (or one) Excel function.    

Most importantly though:
- I don't want to list duplicates (Word function only shows first occurrence)
- They need to be sorted in ASC order
- First acronym is added in cell A2, second one in A3, and so forth

Any help is greatly appreciated.

EEH

P.S.  Also, please ensure to add the >> Microsoft Excel 11.0 Object Library (or 12.0) to the Tools | References (in VBA) <<
MacroCode.txt

How big are your documents?
How many acronyms will you typically find in a document?

I'm not a big fan of concatenation as a substitute for a list if there is a chance of the string being large.

I usually recommend populating a dictionary object and use the object's Exists() method to detect collisions/duplicates.

Since the final destination is Excel, you can put all the found acronyms in a worksheet and use the AdvancedFilter method with a Unique:=True parameter to create your desired unique-value list.

aikimark:

Potentially, a document could contain several hundred acronyms.

As I'm trying to automate this process (office), I want to stay focused on inserting them into an Excel file.  

Do you know how to use the code from the Word function and modify the code for the one/two Excel functions?

Thanks,
EEH

krishnakrkc:

Thank you... I think this is the 98% solution.

Upon copying/pasting the code into my Word document, I've made one code change.  

Changed:
From: Set wbkOpen = wrkFile.Open(oDoc_Source.Path & "\Aconyms.xls")
To: Set wbkOpen = wrkFile.Open("C:\Users\Tom\Desktop\Macro\Acronyms.xls")

I then executed the macro and it inserted the two test acronyms into the XLS.

So far so good...

Then, for testing purposes, I've added another test acronym (e.g., KLML) into the second paragraph.   That is, "Currently, these acronyms are placed into a new Word document.   Instead though, I’d like them to be added into an Excel KLMO file (starting at cells A2 to A###)."

At this time, I've got a run-time error #9 "Subscript out of range".    So, I presume it either doesn't "like" a more than 3-letter term or it doesn't accept additional terms.  

Could you please let me know what might be causing this?   Again, the actual documents to be scanned will have the following terms:

1. Document may contain hundreds of terms
2. Some terms may be listed only once... others may be listed several times throughout the document
3. Some acronyms may be up to 10-characters (or more) in length (i.e., some words might be just capitalized... doesn't mean it's an acronym... but that's ok).

Thousand thanks in advance!!

EEH

I'm not sure if this is substantively different than Kris's.
I'm using a data transfer technique I describe in my Fast Data Push to Excel article:
https://www.experts-exchange.com/A_2253.html

Option Explicit

Public Sub Q_27865018()
    Dim oDoc_Source As Document
    Dim oRange As Range
    Dim lngCount As Long
    Dim strListSep As String
    Dim dicUnique As Object
    Dim strAcronym As String
    Dim appXl As Object
    Dim wks As Object
    Dim vKeys As Variant
    Dim wkb As Object
    Dim vDataArray() As Variant
    Dim lngLoop As Long
    
    Set appXl = CreateObject("excel.application")
    Set dicUnique = CreateObject("scripting.dictionary")
    
    strListSep = Application.International(wdListSeparator)

    Set oDoc_Source = ActiveDocument
    
    'Create new document for acronyms
    
    With oDoc_Source
        Set oRange = .Range
        
        lngCount = 1 'used to count below
        
        With oRange.Find
            'Use wildcard search to find strings consisting of 2 or more uppercase letters
            'Set the search conditions
            'NOTE: If you want to find acronyms with 2 or more letters,
            'change 3 to 2 in the line below
            .Text = "<[A-Z]{2" & strListSep & "}>"
            .Forward = True
            .Wrap = wdFindStop
            .Format = False
            .MatchCase = True
            .MatchWildcards = True
            
            'Perform the search
            Do While .Execute
                'Continue while found
                strAcronym = oRange.Text
                
                'If strAcronym is already in strAllFound, do not add again
                If dicUnique.Exists(strAcronym) Then
                Else
                    dicUnique.Add strAcronym, 1
                End If
            Loop
        End With
    End With
    vKeys = dicUnique.keys
    ReDim vDataArray(LBound(vKeys) To UBound(vKeys), 0)
    'transfer the acronyms to a 2D array for transfer to Excel
    For lngLoop = LBound(vKeys) To UBound(vKeys)
        vDataArray(lngLoop, 0) = vKeys(lngLoop)
    Next
    
    Set wkb = appXl.Workbooks.Open("C:\Users\Tom\Desktop\Macro\Acronyms.xls")
    Set wks = wkb.sheets(1)
    wks.Range(wks.Cells(2, 1), wks.Cells(dicUnique.Count + 1, 1)).Value = vDataArray()
    wks.Range("a2").currentregion.Sort wks.Cells(2, 1), 1, Header:=1
    wkb.Save
    wkb.Close
    Set wkb = Nothing
    Set appXl = Nothing
End Sub

Select allOpen in new window

aikimark:

That's the 99.9% solution.    Only thing that's missing is the feedback (i.e., pop-up) indicating the n number of acronyms were added to the XLS...

Followed by opening up the XLS.

Where would I put this code again?

Thanks,
EEH

aikimark -- thank you for providing this solution... I'm confident that it addresses all the requirements.   (I'll do some additional testing but for right now it looks great).

krishnakrkc -- thank you for your assistance as well... it looked like it addressed the question but in the end, longer acronyms resulted in throwing a run-time error.

That said, the best solution was provided by aikimark (400 pts)... but I wanted to also acknowledge the work by krish... hopefully that's ok by the two of you.

Again, thanks!

EEH