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...
[VBA]
'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
[/VBA]

[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 but nice nonetheless.