Build alphabetical order if the word is in different part of the sentence

[makiwara]

Hi!

This seems a very interesting code for me, however I couldn't figure out how I could solve it.

I need to build an alphabeticel order from the words of cells.
Sample:

Column "A" (Input)

The apple is red.
Banana is unhealthy.
Cambridge is a very nice place.
Buy a camion.
Visiting Canada is always a fun.

Column "B" (Output)
apple
banana
cambridge
camion
canada (upper and lower case doesnt matter)

So if B1 is given (apple) and we compare each word of a cell in column "A" to find the closest word to apple, then the list could be built.

The apple is red. Apple
Banana is unhealthy. From these words which is the nearest to apple? --> Banana
Cambridge is a very nice place. to Banana? --> Cambridge
Buy a camion. and so on...
Visiting Canada is always a fun.

Or if we make an alphabetical order using the words in A2 (Banana is unhealthy) and B1 (Apple), then the word after "apple" is the word we need
1. apple
2. banana
3. is
4. unhealthy

Banana is after apple, so that is what we need.

Sory for the long explanation.

Is there anybody, who could solve this using VBA code?

Thank you for your help! Have a very nice day!

 

[Peter_SSs]

I need to build an alphabeticel order from the words of cells.
Sample:

Column "A" (Input)

The apple is red.
Banana is unhealthy.
Cambridge is a very nice place.
Buy a camion.
Visiting Canada is always a fun.

Column "B" (Output)
apple
banana
cambridge
camion
canada (upper and lower case doesnt matter)

There might be some further issues with punctuation etc, but see if this is headed in the right direction.


Run the 'MakeList' macro

Sub MakeList()
  Dim CurrWord As String
  Dim c As Range

  For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp))
    CurrWord = WordAfter(c.Value, CurrWord)
    c.Offset(, 1).Value = CurrWord
  Next c
End Sub

Function WordAfter(s As String, sWord As String) As String
  Static AL As Object
  Dim SortedWords As Variant, e As Variant
  
  If AL Is Nothing Then Set AL = CreateObject("System.Collections.ArrayList")
  AL.Clear
  For Each e In Split(s)
    If Not AL.Contains(e) Then AL.Add e
  Next e
  AL.Add sWord
  AL.Sort
  SortedWords = AL.ToArray
  WordAfter = SortedWords(Application.Match(sWord, SortedWords, 0))
End Function

Data in col A, result of code in col B.

Book1
	A	B
1	The apple is red.	apple
2	Banana is unhealthy.	Banana
3	Cambridge is a very nice place.	Cambridge
4	Buy a camion.	camion.
5	Visiting Canada is always a fun.	Canada
Alphabetical

 

[makiwara]

Hi Peter!

Thank you for your quick reply, I'm very excited to see you could solve this so fast!

I see, that it works fine for you, but by me it highlights the last row:
WordAfter = SortedWords(Application.Match(sWord, SortedWords, 0))

I run the code on the sample too, (giving the value "apple" to the cell of B1) but unfortunately something is wrong on my side.
https://imgur.com/a/YPmqxgj

Do you have any idea? (Excel 2016)

 

[Peter_SSs]

Yes, my mistake, I had an error in the data that led me to use incorrect code.
Still could be problems, but try changing the function part to this

Function WordAfter(s As String, sWord As String) As String
  Static AL As Object
  Dim SortedWords As Variant, e As Variant
  
  If AL Is Nothing Then Set AL = CreateObject("System.Collections.ArrayList")
  AL.Clear
  For Each e In Split(s)
    If Not AL.Contains(e) Then AL.Add e
  Next e
  If sWord <> "" Then AL.Add sWord
  AL.Sort
  SortedWords = AL.ToArray
  WordAfter = SortedWords(IIf(sWord = "", 0, Application.Match(sWord, SortedWords, 0)))
End Function