What a prat
. And worst of all, I deleted it so I have had to re-do it
.... sigh!
Here it is
Option Explicit
Function MultiConcat(rng As Range, _
Optional separator As String = ",")
Dim cell As Range
Dim cSize As Long
Dim fByRows As Boolean
Dim fNotFirst As Boolean
Dim aryData
Dim vKey1, vkey2
Dim i As Long, j As Long
Dim stemp
'validate input
If rng.Rows.Count > 1 And rng.Columns.Count > 1 Then
MultiConcat = "Select a single column or row array"
Exit Function
ElseIf rng.Rows.Count = 1 And rng.Columns.Count = 1 Then
MultiConcat = "Oly one cell selected"
ElseIf rng.Rows.Count > 1 Then
fByRows = True
cSize = rng.Rows.Count
Else
cSize = rng.Columns.Count
End If
'initialise all the checking data
vKey1 = rng(1, 1).Offset(0, -1).Value
vkey2 = rng(1, 1).Offset(0, 1).Value
'allow an extra 2 for the check values
ReDim aryData(1 To cSize, 1 To cSize + 2)
aryData(1, 1) = vKey1
aryData(1, 2) = vkey2
i = 1: j = 3
stemp = ""
For Each cell In rng
If cell.Value <> "" Then
If cell.Offset(0, -1) = vKey1 And cell.Offset(0, 1).Value =
vkey2 Then
If fNotFirst Then
stemp = stemp & separator & cell.Value
Else
stemp = cell.Value
fNotFirst = True
End If
Else
aryData(i, j) = stemp
stemp = ""
'clear down the rest of this dimension of the array
If j < UBound(aryData, 2) Then
For j = j + 1 To UBound(aryData, 2)
aryData(i, j) = ""
Next j
End If
stemp = cell.Value
aryData(i, 1) = vKey1
aryData(i, 2) = vkey2
vKey1 = cell.Offset(0, -1).Value
vkey2 = cell.Offset(0, 1).Value
i = i + 1
j = 3
End If
End If
Next cell
'pick up o/s data
aryData(i, 1) = vKey1
aryData(i, 2) = vkey2
aryData(i, j) = stemp
'clear down the rest of this dimension of the array
If j < UBound(aryData, 2) Then
For j = j + 1 To UBound(aryData, 2)
aryData(i, j) = ""
Next j
End If
'clear down the rest of the array
If i < UBound(aryData, 1) Then
For i = i + 1 To UBound(aryData, 1)
For j = 1 To UBound(aryData, 2)
aryData(i, j) = ""
Next j
Next i
End If
MultiConcat = aryData
End Function
--
HTH
RP
(remove nothere from the email address if mailing direct)
