|
VBA Question /
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 ? 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 |
Carl,
stemp may be getting too long: strings can only be up to 32K characters or so. HTH, Bernie MS Excel MVP "carl" wrote in message ... 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 ? 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 |
Thank you Bernie. I do not see a way to change that value. Is there ?
If not, is there a modification that can be used in the code to overcome this limit ? Thank you in advance. "Bernie Deitrick" wrote: Carl, stemp may be getting too long: strings can only be up to 32K characters or so. HTH, Bernie MS Excel MVP "carl" wrote in message ... 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 ? 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 |
| All times are GMT +1. The time now is 10:41 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com