VBA / STEMP Question

[carl]

I am using this VBA code (created by Bob Phillips - Thank You Bob). I am
trying to use it an a 4000 row column. It appears to have a limit of 75 rows.
Is there a way to modify the code to handle the larger task ?

One of the paticipants in this discussion has mentioned that the "stemp" may
be the limiting factor.

Thank you in advance...

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

 

[Bob Phillips]

Which discussion?

I did suggest this at the time

Yeah, it must be the size of the array that is the problem.


I have dimensioned the array both ways at maximum size, this is overkill and
a problem here. Try changing this line


ReDim aryData(1 To cSize, 1 To cSize + 2)


to


ReDim aryData(1 To cSize, 1 To 12)


or a number 2 greater that the maximum number of values in C for any
date/letter combination

 

[carl]

Thank you Bob.

I posted yesterday and Bernie Detrieck replied that the problem might be
stemp. I did replace the array dimension as you sugested and this worked on
the original data table.

I am now trying to use the code on a larger data table - and have run into
the current problem.

Can I send you an example spreadsheet ?

Best Regards.

 

[Bob Phillips]

You can try it.

--
HTH

Bob Phillips

Thank you Bob.

I posted yesterday and Bernie Detrieck replied that the problem might be
stemp. I did replace the array dimension as you sugested and this worked on
the original data table.

I am now trying to use the code on a larger data table - and have run into
the current problem.

Can I send you an example spreadsheet ?

Best Regards.