Here are 3 functions.

The first function is a modification of your first routine.

I've made the following changes:

(a) str is the name of a VBA function. It's not a good idea to try to use it

as a variable name, even though the compiler will let you.

(b) string operations are very slow in Basic. It's best to save the length of

the longest string in a variable, and the location in the array where you

found it. Then, at the end, copy the string in that location to the function

name.

(c) I save the length of the current array element in a variable, too, rather

than calling the Len function a 2nd time

The 2nd function is a roll-your-own routine to find, specifically, the 2nd

longest string. But to modify it to find the 3rd or 4th longest would require

extensive changes.

I'm expecting your next question will be "Can you find the 3rd (or 4th, or

5th) longest" <g>. So the function uses a 2nd argument, which one you want to

find.

Option Explicit

Function LongestWord(sText As String)

' Returns the longest word in a string of words

Dim x As Variant

Dim i As Long

Dim n As Long

Dim p As Long

Dim Max As Long

x = Split(Application.Trim(sText), " ")

Max = 0

p = 0

For i = 0 To UBound(x)

n = Len(x(i))

If n > Max Then

Max = n

p = i

End If

Next i

LongestWord = x(p)

End Function

Function SecondLongest(sText As String) As Variant

Dim i As Long

Dim Max1 As Long

Dim Max2 As Long

Dim n As Long

Dim p As Long

Dim x As Variant

x = Split(Application.Trim(sText), " ")

If UBound(x) + 1 < 2 Then

SecondLongest = CVErr(xlErrValue)

Exit Function

End If

p = 0

Max1 = 0

Max2 = 0

For i = 0 To UBound(x)

n = Len(x(i))

If n > Max1 Then

Max1 = n

ElseIf n > Max2 Then

Max2 = n

p = i

End If

Next i

SecondLongest = x(p)

End Function

Function NthLongestWord(sText As String, Which As Long) As Variant

Dim i As Long

Dim Max As Long

Dim x As Variant

Dim y() As Long

x = Split(Application.Trim(sText), " ")

Max = UBound(x)

If Which > (Max + 1) Then

NthLongestWord = CVErr(xlErrValue)

Exit Function

End If

ReDim y(0 To Max)

For i = 0 To Max

y(i) = Len(x(i))

Next i

Max = Application.Large(y(), Which)

i = Application.Match(Max, y, 0) - 1

NthLongestWord = x(i)

End Function