Array to line list

[gmaxey]

I'm trying create a written out list from a delimited list.

For example "Apple" "Apple|Peach" "Apple|Peach|Pear" will be written out as:

Apple
Apple and Peach
Apple, Peach and Pear

A few of you here can usually do in 5 lines of code what takes me ten. Any suggestion to streamline the following:


[Option Explicit
Sub Demo()
MsgBox fcnLineList("Apple")
MsgBox fcnLineList("Apple|Peach")
MsgBox fcnLineList("Apple|Peach|Pear")
MsgBox fcnLineList("Apple|Peach|Pear|Plum")
MsgBox fcnLineList("Apple|Peach|...|...|...|Pear|Plum")
End Sub
Function fcnLineList(ByRef strIn As String) As String
Dim arrIn() As String
Dim lngIndex As Long
If Right(strIn, 1) = "|" Then strIn = Left(strIn, Len(strIn) - 1)
arrIn = Split(strIn, "|")
Select Case UBound(arrIn)
Case 0
fcnLineList = arrIn(0)
Case 1
fcnLineList = arrIn(0) & " and " & arrIn(1)
Case Else
For lngIndex = 0 To UBound(arrIn) - 2
fcnLineList = fcnLineList & arrIn(lngIndex) & ", "
Next lngIndex
fcnLineList = fcnLineList & arrIn(UBound(arrIn) - 1) & " and " & arrIn(UBound(arrIn))
End Select
End Function

[macropod]

Hi Greg,

You could omit the Case 1 processing.

Here's an alternative function:

Function fcnLineList(ByRef strIn As String) As String
Dim StrTmp As String
If Right(strIn, 1) = "|" Then strIn = Left(strIn, Len(strIn) - 1)
Select Case UBound(Split(strIn, "|"))
Case 0: fcnLineList = strIn
Case Else
StrTmp = Left(strIn, InStrRev(strIn, "|") - 1)
fcnLineList = Replace(StrTmp, "|", ", ") & " and " & Split(strIn, "|")(UBound(Split(strIn, "|")))
End Select
End Function

[gmaxey]

Paul,

Very nice. Thanks!

[Frosty]

Variant on the theme, not using an array, but just using replace...

'convert pipe-delimited string to comma with and as last item
Public Function fGiveMePhrase(ByVal sTest As String) As String
Dim i As Integer

'not sure if you need this...
If Right(sTest, 1) = "|" Then
sTest = Left(sTest, Len(sTest) - 1)
End If
sTest = Replace(sTest, "|", ", ")
'get position of last comma
i = InStrRev(sTest, ", ")
'and replace it with " and ", preserving the first part of the string
If i > 0 Then
sTest = Left(sTest, i - 1) & Replace(sTest, ", ", " and ", i, 1)
End If
fGiveMePhrase = sTest
End Function

[gmaxey]

Thanks Jason! Nice as well.

[Bob Phillips]

Another one


Function fcnLineList(ByRef strIn As String) As String
If Right(strIn, 1) = "|" Then strIn = Left(strIn, Len(strIn) - 1)
fcnLineList = Replace(Replace(strIn, "|", ", ", 1, Len(strIn) - Len(Replace(strIn, "|", "")) - 1), "|", " and ")
End Function

[gmaxey]

xld,

Typically my skull starts to crack with the first nested Replace method :doh:but nice nonetheless.