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-pro...-occurred.html
Please read VBA Express' policy on Cross-Posting in item 3 of the rules: http://www.vbaexpress.com/forum/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.