Option Explicit
Sub Test_ListOfVals()
Dim N As Integer
Dim xlCell As Range
Dim xlVals(25) As Variant
N = 0
For Each xlCell In Selection
N = N + 1
If N > 25 Then
MsgBox "too much data for this demo (limited to 25 values)" & vbCrLf & _
"continuing with 25 values", vbCritical + vbOKOnly
N = 25
Exit For
End If
xlVals(N) = xlCell.Value
Next xlCell
MsgBox "Demo of ListOfVals {using defaults}" & vbCrLf & vbCrLf & _
ListOfVals(xlVals, N)
MsgBox "Demo of ListOfVals {CrLf = 1}" & vbCrLf & vbCrLf & _
ListOfVals(xlVals, N, , 1)
MsgBox "Demo of ListOfVals {CrLf = 1, Index = 1}" & vbCrLf & vbCrLf & _
ListOfVals(xlVals, N, , 1, , 1)
If Selection.Column = 4 Then
MsgBox "Demo of ListOfVals {CrLf = 1, DecPt = 3, Index = 1}" & vbCrLf & vbCrLf & _
ListOfVals(xlVals, N, , 1, 3, 1)
End If
End Sub
Function ListOfVals(X, N, _
Optional Separ As String = " ", _
Optional CrLf As Integer = 0, _
Optional DecPt As Integer = 0, _
Optional Index As Integer = -1) As String
Dim I As Long, CrLfCount As Long
Dim strFormat As String
If DecPt > 0 Then strFormat = "#." & String(DecPt, "#")
ListOfVals = ""
CrLfCount = 0
For I = 1 To N
Select Case Index
Case Is = -1
Case Is = 0
ListOfVals = ListOfVals & "[" & Trim(I - 1) & "] "
Case Is = 1
ListOfVals = ListOfVals & "[" & Trim(I) & "] "
End Select
If DecPt < 1 Then
ListOfVals = ListOfVals & X(I) & Separ
Else
ListOfVals = ListOfVals & Format(X(I), strFormat) & Separ
End If
CrLfCount = CrLfCount + 1
If CrLfCount = CrLf Then
ListOfVals = ListOfVals & vbCrLf
CrLfCount = 0
End If
Next I
End Function
|