Macro to identify different parts of speech

[Nomad03]

Hi,

I would HUGELY appreciate if any of you could share the VBA formula to identify different parts of speech among the list of words listed in Column A.

Suppose, I have "I have a question" listed as four words in column A and have all parts of speech listed in the top row of each column like, "Noun", "Pronoun","Verb", "Conjunction", etc. Is there any way a macro can be run which would list all the words of column A below the appropriate parts of speech columns. Like "I" under "Pronoun", "have" under "Verb", and so on.

I found a similar thread but it produces synonyms of the words listed. I am not sure if it would be helpful but here is the link: http://www.mrexcel.com/forum/excel-...st-excel-using-visual-basic-applications.html


Thank you a lot in advance.

 

[Macropod]

Did you try the code in the link? It would only have taken a few moments to do so...

As interesting as the code in that link is, it also demonstrates a fundamental problem with what you're trying to do; many words exist in more than one part of speech. For example, suppose your list consists of:
aircraft
stock
hold
run
green
high

Using the code in the link:
• aircraft will only be reported as a noun, yet it could also be an adjective, as in 'aircraft carrier'.
• stock will be reported as an adjective, as a verb and as a noun.
• hold and run will all be reported as both a verb and a noun.
• green and high will both be reported as both an adjective and a noun.
As you can see, the part of speech a word belongs to depends on its context; there is no definitive solution apart from one that employs contextual analysis.

 

[Nomad03]

Yes, I did try the code mentioned in the other post. That's why I wrote that it produces synonyms of the word. Just to elaborate,it produces synonyms in all parts of speech like what its synonym will be in verb, noun, etc.

As long as the formula identifies any or all parts of speech the word corresponds to, I am ok.

Using your example, if it identifies aircraft just as noun and not any other, it will work.

 

[Macropod]

If all you need is a list of the reported parts of speech, you could use:

Public Sub PartsOfSpeech()
 
  Dim mObjWord As Word.Application
  Dim mySynInfo As Word.SynonymInfo
  Dim myList As Variant
  Dim myPos As Variant
  Dim i As Long, j As Long
  Dim iMax As Long
  Dim thisPos As String
  Dim oCell As Range
  Dim StrParts As String
 
  Set mObjWord = CreateObject("Word.Application")
  
  iMax = 1
 
  For Each oCell In Selection
    oCell.Offset(0, 1).Resize(1, 99).ClearContents: StrParts = "|": j = 0
    If oCell.Column = 1 And Not IsEmpty(oCell) Then
      Set mySynInfo = SynonymInfo(Word:=oCell.Value, LanguageID:=wdEnglishUS)
      If mySynInfo.MeaningCount <> 0 Then
        myList = mySynInfo.MeaningList
        myPos = mySynInfo.PartOfSpeechList
        If i > iMax Then iMax = i
        For i = 1 To UBound(myPos)
          Select Case myPos(i)
            Case wdAdjective
              thisPos = "adjective"
            Case wdNoun
              thisPos = "noun"
            Case wdAdverb
              thisPos = "adverb"
            Case wdVerb
              thisPos = "verb"
            Case wdConjunction
              thisPos = "conjunction"
            Case wdIdiom
              thisPos = "idiom"
            Case wdInterjection
              thisPos = "interjection"
            Case wdPreposition
              thisPos = "preposition"
            Case wdPronoun
              thisPos = "pronoun"
             Case Else
              thisPos = "other"
          End Select
          If InStr(StrParts, "|" & thisPos & "|") = 0 Then
            j = j + 1
            oCell.Offset(0, j) = thisPos
            StrParts = StrParts & thisPos & "|"
          End If
        Next i
      Else
        oCell.Offset(0, 2) = "No meanings found"
      End If
    End If
  Next oCell
  
  For i = 3 To iMax
    Columns(i).EntireColumn.AutoFit
  Next i
 
End Sub

 

[Nomad03]

Thank you! It worked. You are the real MVP.

 

[Macropod]

For a refinement, you might try:

Public Sub PartsOfSpeech()
  Application.ScreenUpdating = False
  Dim mObjWord As Word.Application
  Dim mySynInfo As Word.SynonymInfo
  Dim myList As Variant, myPos As Variant
  Dim i As Long, j As Long
  Dim thisPos As String, oCell As Range
  Set mObjWord = CreateObject("Word.Application")
  For Each oCell In Selection
    oCell.Offset(0, 1).Resize(1, 99).ClearContents
    If oCell.Column = 1 And Not IsEmpty(oCell) Then
      Set mySynInfo = SynonymInfo(Word:=oCell.Value, LanguageID:=wdEnglishUS)
      If mySynInfo.MeaningCount <> 0 Then
        myList = mySynInfo.MeaningList
        myPos = mySynInfo.PartOfSpeechList
        For i = 1 To UBound(myPos)
          Select Case myPos(i)
            Case wdAdjective
              thisPos = "adjective": j = 2
            Case wdNoun
              thisPos = "noun": j = 3
            Case wdAdverb
              thisPos = "adverb": j = 4
            Case wdVerb
              thisPos = "verb": j = 4
            Case wdConjunction
              thisPos = "conjunction": j = 5
            Case wdIdiom
              thisPos = "idiom": j = 6
            Case wdInterjection
              thisPos = "interjection": j = 7
            Case wdPreposition
              thisPos = "preposition": j = 8
            Case wdPronoun
              thisPos = "pronoun": j = 9
             Case Else
              thisPos = "other": j = 10
          End Select
          oCell.Offset(0, j) = thisPos
        Next i
      Else
        oCell.Offset(0, 1) = "No meanings found"
      End If
    End If
  Next oCell
  Columns.EntireColumn.AutoFit
  mObjWord.Quit: Set mObjWord = Nothing
  Application.ScreenUpdating = True
End Sub