| Home |
| Search |
| Today's Posts |
|
#1
|
|||
|
|||
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 |
|
#2
|
|||
|
|||
|
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 |
|
#3
|
|||
|
|||
|
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 |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Possibly a loaded question, but I think | Excel Discussion (Misc queries) | |||
| How do I find and replace a question mark in Excel? | Excel Discussion (Misc queries) | |||
| Hints And Tips For New Posters In The Excel Newsgroups | Excel Worksheet Functions | |||
| Question about combining data from multiple workbooks into one rep | Excel Discussion (Misc queries) | |||
| An easy macro question and one I believe to be a little more diffi | Excel Worksheet Functions | |||
Linear Mode
