Find list of words occurred

[mohanjackie]

I am week in creating macro
I tried all sort of ideas and add-ins, I couldn't find the solution

How can i find list of word occurred in doc(Microsoft word)

List of word is in excel A row

eg:

MAN
i am tiger
The wolf

So, the macro needs to find number of times this keywords occurred in the article situated in doc in the same folder

I found a code while searching google, but it only stats true or false

[snb]

Continue your course in VBA and pass the exams before posting here.

[mohanjackie]

course?

i am here for the help

[YasserKhalil]

Solved on another thread. Please put the links of the thread on the other forum

[macropod]

Can't have looked real hard. I've posted macros for this in numerous forums - as have others - some recently; others going back decades.

[macropod]

Cross-posted at: https://www.excelforum.com/excel-programming-vba-macros/1201502-find-list-of-words-occurred.html
Please read VBA Express' policy on Cross-Posting in item 3 of the rules: http://www.vbaexpress.com/forum/faq.php?faq=new_faq_item#faq_new_faq_item3

[mohanjackie]

i ask sorry for violating the policy of the vbaexpress :(

In future i look after that i wont break any policy regarding this website.

Any way i got the problem solved

This the vba i was looking for, both works good

Thanks to karedog and sktneer for this wonderful code specially used for seo purpose

VBA 1 by:karedog


Sub Test()
Dim a, i As Long, strContent As String
With CreateObject("Word.Application")
With .Documents.Open(ThisWorkbook.Path & "\doc.docx")
strContent = .Content.Text
.Close
End With
.Quit
End With
With Sheets("Keyword Tool Export - Check Sea").Range("A1").CurrentRegion
a = .Value
With CreateObject("VBScript.RegExp")
.Global = True
.IgnoreCase = True
For i = 2 To UBound(a, 1)
.Pattern = Replace$(a(i, 1), ".", "\.")
If .Test(strContent) Then a(i, 2) = .Execute(strContent).Count
Next i
End With
.Value = a
End With
End Sub




VBA 2 by: sktneer


Sub WordCount()
Dim SelectedFile As String
Dim wdApp As Object
Dim Doc As Object
Dim WordToCount As String
Dim Cnt As Integer, lr As Long
Dim Rng As Range, Cell As Range

Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select The Word Document!"
.ButtonName = "Confirm"
.Filters.Clear
.Filters.Add "Word Documents", "*.docx"
If .Show = -1 Then
SelectedFile = .SelectedItems(1)
Else
MsgBox "You didn't select a document.", vbExclamation, "Document Not Selected!"
Exit Sub
End If
End With

lr = Cells(Rows.Count, 1).End(xlUp).Row
Set Rng = Range("A2:A" & lr)

Set wdApp = CreateObject("Word.Application")

Set Doc = wdApp.documents.Open(SelectedFile)

For Each Cell In Rng
Cnt = 0
With wdApp.Selection
.HomeKey Unit:=6
With .Find
.ClearFormatting
.Text = Cell.Value
Do While .Execute
Cnt = Cnt + 1
wdApp.Selection.MoveRight
Loop
End With
End With
Cell.Offset(0, 1).Value = Cnt
Next Cell
Application.ScreenUpdating = True

Skip:
wdApp.Quit
Set Doc = Nothing
Set wdApp = Nothing
MsgBox "Task completed.", vbInformation, "Done!"
End Sub

[snb]

I do not applaud.