Excel VBA Join function - arrays

I try to join the elements of a vector in vba.
First I search with a for loop specific strings.
CE_addr = FindAll(Workbooks("raw_data.xlsm").Worksheets("IQ_Key_Dev_Type").Cells(k, (p - 1)).Value, _
Worksheets("Sheet1").Range("O:O"), xlValues, xlWhole).Address
Afterwards I use the address object to get the corresponding values one column to the right.
rn = Split(CE_addr, ",")
n = UBound(rn, 1) - LBound(rn, 1)
For w = 0 To n
ReDim CE_cod(n) As Variant
CE_cod((w)) = Workbooks("raw_data.xlsm").Worksheets("CE_List").Range(rn(w))
Next w
So in the CE_cod vector I save all the corresponding values (sometimes it's just one value, sometimes more than one)
And now I want to concatenate all the contained (text) values with ";" as delimiter:
Cells(j, 3) = Join(CE_cod, ";")
Let's assume CE_cod has two entries in the first loop: ["XXX" , "YYY"]
and just one in the second loop: ["XXX"]
For some reason the result in Cell(j,3) in the first case (multiple values in CE_cod) is: ";YYY" (note that a delimiter is added, but not the expression itself).
In the second case the result is: "XXX"
I checked if the vector CE_cod contains all values with:
Cells(j, (10 + w)) = CE_cod((w))
and indeed, when I do this "XXX" and "YYY" are contained.
So why does the join function skips the first entry of the vector when there are multiple entries?
PS: I found the "FindAll" function here:
http://www.tushar-mehta.com/publish_train/xl_vba_cases/1001%20range.find%20and%20findall.shtml#_The_FindAll_function

I think your CE_cod populating loop should be closer to this.
Dim CE_cod As Variant
ReDim CE_cod(LBound(rn) to UBound(rn))
For w = LBound(rn) to UBound(rn)
'if you want to put a redim here, use Preserve
'ReDim Preserve CE_cod(w)
CE_cod(w) = Workbooks("raw_data.xlsm").Worksheets("CE_List").Range(rn(w))
Next w
The rn array is populated from a Split operation and as such, it is a zero-based, 1-D array.
Additionally, you shouldn't be using ReDim inside a loop without the Preserve parameter if you want to retain your values. In any event, there is no need to ReDim inside the loop since you know the target boundaries beforehand.

Related

How to Pass an Array to and from a Function?

(Fair Warning, I am self taught on VBA so I apologize in advance for any cringe-worthy coding or notations.)
I have an estimating worksheet in excel. The worksheet will have a section for the user to input variables (which will be an array). The first input variable will "reset" the remaining input variables to a standard value when the first variable is changed. The standard values for the input variables are stored in a function in a module. I am attempting to fill the input variable array with the standard values from the function and then display those values on the sheet. I was easily able to do this without arrays but have had no luck in moving everything into arrays.
This is for excel 2010. I previously did not use arrays and created a new variable when needed, however the estimating sheet has grown much larger and it would be better to use arrays at this point. I have googled this question quite a bit, played around with removing and adding parenthesis, changing the type to Variant, trying to set the input variable array to be a variable that is an array (if that makes sense?), and briefly looked into ParamArray but that does not seem applicable here.
Dim BearingDim(1 To 9, 1 To 4, 1 To 8) As Range
Dim arrBearingGeneral(1 To 5, 1 To 8) As Range
Dim Test As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
'Set General Variable array to cells on the worksheet
For i = 1 To 5
For j = 1 To 8
Set arrBearingGeneral(i, j) = Cells(9 + i, 3 + j)
Next j
Next i
'Set Bearing Input Variables to Cells on the Worksheet
For p = 1 To 4
For i = 1 To 9
Select Case p
Case Is = 1
Set BearingDim(i, p, 1) = Cells(16 + i, 4)
Case Is = 2
Set BearingDim(i, p, 1) = Cells(27 + i, 4)
Case Is = 3
Set BearingDim(i, p, 1) = Cells(37 + i, 4)
Case Is = 4
Set BearingDim(i, p, 1) = Cells(49 + i, 4)
End Select
Next i
Next p
'Autopopulate standard input variables based on Bearing Type
inputMD_StdRocker BearingType:=arrBearingGeneral(1, 1), _
arrBearingDim:=BearingDim
End Sub
Sub inputMD_StdRocker(ByVal BearingType As String, ByRef _
arrBearingDim() As Variant)
Dim arrBearingDim(1 To 9, 1 To 4)
Select Case BearingType
Case Is = "MF50-I"
For j = 1 To 2
arrBearingDim(2, j) = 20
arrBearingDim(3, j) = 9
arrBearingDim(4, j) = 1.75
Next j
arrBearingDim(5, 1) = 15
'There are numerous more select case, but those were removed to keep it
'short
End Select
End Sub
The expected output is my "BearingDim" Array will have certain array index values set to a standard value from the "inputMD_StdRocker" function. Then those values will be displayed in the cell that corresponds to the array index.
Currently, I get a compile error "Type Mismatch, Array or User-Defined Type Expected". I have been able to get around the type mismatch by removing the () from "arrBearingDim()" in the function title for "inputMD_StdRocker" however, it will not pass the values back to my "BearingDim" array.
Any help would be greatly appreciated.
This is a partial answer to what (I think) is a misunderstanding you have of how to use arrays. There are a few problems in your code.
First, you're defining a two-dimensional and a three-dimensional array of Ranges when I believe you really only want to store the values captured from the worksheet. (If I'm wrong, then you are never initializing the array of Ranges, so none of the ranges in the array actually point to anything.)
Secondly, it looks as if your initial array arrBearingGeneral is always filled from the same (static) area of the worksheet. If this is so (and you really do want the values from the cells, not an array of Range objects), then you can create a memory-based array (read this website, especially section 19). So the first part of your code can be reduced to
'--- create and populate a memory-based array
Dim bearingDataArea As Range
Dim arrBearingGeneral(1 To 5, 1 To 8) As Variant
Set bearingDataArea = ThisWorkbook.Sheets("Sheet1").Range("D10:K14")
arrBearingGeneral = bearingDataArea.Value
Optionally of course you can calculate the range of your data instead of hard-coding it ("D10:K14"), but this example follows your own example.
While this isn't a complete answer, hopefully it clears up an issue to get you farther down the road.

Excel transpose 2D array - Out of memory issue

I have a VBA macro, where I want to write out an array to an Excel sheet.
I'm getting an "Out of memory" runtime error on some machines. I can run it easily on my development PC, but my client has issues with it.
Here I define my Values array:
Dim Values()
Dim idx As Long
idx = 0
Then I have a for cycle where I dynamically redim the array, and add my values to it:
for cycle...
ReDim Preserve Values(16, 0 To idx)
Values(0, idx) = "some text"
Values(1, idx) = "some other text"
....
Values(15, idx) = "last values for this row"
idx = idx + 1
next
Then here is where my code fails:
With ws
.Range(.Cells(1, 1), .Cells(1+ idx - 1, 16)).value = TransP(Values)
End With
Here's the TransP transposing function:
Public Function TransP(var As Variant) As Variant
Dim outP() As Variant, i As Long, j As Long
ReDim outP(LBound(var, 2) To UBound(var, 2), LBound(var, 1) To UBound(var, 1))
For i = LBound(outP) To UBound(outP)
For j = LBound(var) To UBound(var)
outP(i, j) = var(j, i)
Next
Next
TransP = outP
End Function
As I said, I can run the macro, and get something like 108770 rows. The same 108770 rows don't work on my clients PC.
I expect that the TransP function gives up on his PC, so should I split up the array into multiple smaller chunks, and write them 1 by 1?
Or my data model is not good?
You could also create a loop to write your output array row by row, it will take more time but you will most likely don't get out of memory error.
In the past when I've got out of memory issues with an arrays I just tried to perform actions using regular excel commands, in this case you could just copy range and than paste transposed values:
.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Your method of appending elements to Values is inefficient because every time an element is added a new array is created and the values of the existing one copied to it. During this time twice the memory is in use, and if a large array is copied in this way multiple times in quick succession only heaven can know what demands are put on the RAM management.
The better way is to dimension the array larger than will be required (once), count the number of elements written to it and use Redim Preserve to reduce its size (once) when you are done.
I suspect this might be due to you not specifying the dimension in your TransP function. You are also defining your loops with both arrays. You've sized them identically (although with the dimensions switched) - Just use the same one to define your For loop
Public Function TransP(var As Variant) As Variant
Dim outP() As Variant, i As Long, j As Long
ReDim outP(LBound(var, 2) To UBound(var, 2), LBound(var, 1) To UBound(var, 1))
For i = LBound(outP, 1) To UBound(outP, 1)
For j = LBound(outP, 2) To UBound(outP, 2)
outP(i, j) = var(j, i)
Next
Next
TransP = outP
End Function
I don't think it's the TransP function, since that is already handling everything in a loop. I experienced the same sort of issue and there this error occured when I tried to transfer a large multidimensional array to a range.
My solution was to create a loop and do about a 1000 rows each time, but that depends on the clients pc I guess with how many rows you can do.
To take into account that var will not end on a certain step size, you could do a while loop:
i = 0
with ws
Do while i < Ubound(var)
max = application.worksheetfunction.max(1000,Ubound(var) - i) 'At some point, you could have less than 1000 left
.range(.cells(i+1,1), .cells(i+max)) = TransP(var,i,max)
i = i + 1000
Loop
In TransP you now use the lower- and upperbound of var, but if you add two variables from the loop, you can use them to only take a piece of the array.

LotusScript ans Two dimensional Array & subscription out or range error

Hello I have two dimensional array as below in LotusScript.
Counter = 0
While Not (ProcessingViewDoc Is Nothing )
Redim Preserve AllRecrods(Counter,0)
AllRecrods(Counter,0) = ProcessingViewDoc.Test1(0)
Redim Preserve AllRecrods(Counter,1)
AllRecrods(Counter,1) = ProcessingViewDoc.Test2(0)
Redim Preserve AllRecrods(Counter,2)
Set ProcessingViewDoc = ProcessingView.GetNextDocument(ProcessingViewDoc)
Counter = Counter +1
Wend
When It processes next document it does and reaches to counter 1 and second document it gives me error subscription out of range.
Here is global declaration of array.
Dim AllRecrods() As Variant
Here is the line when it gives error when it goes to loop second time.
Redim Preserve AllRecrods(Counter,0)
In addition to Richard's excellent answer, I would suggest a couple of things.
1) Instead of While Not (ProcessingViewDoc Is Nothing) (which contains two negatives, making it harder to read), use Do Until doc Is Nothing. It is much clearer.
2) If you use a list, you don't have to worry about redim of the array. You could make it a list of a custom data type, and if you use the UNID of the document as the key, you can quickly connect the values back to the originating document.
My code would look something like this:
--- Declarations ---
Type recordData
value1 As String
value2 As String
End Type
--- Main Code ---
Dim allRecords List As recordData
Dim unid as String
Do Until ProcessingViewDoc Is Nothing
unid = ProcessingViewDoc.UniqueID
allRecords(unid).value1 = ProcessingViewDoc.Test1(0)
allRecords(unid).value2 = ProcessingViewDoc.Test2(0)
Set ProcessingViewDoc = ProcessingView.GetNextDocument(ProcessingViewDoc)
Loop
You are using ReDim with the Preserve option and changing both of the dimensions. You can't do that.
From the documentation for the ReDim statement:
If Preserve is specified, you can change only the upper bound of the
last array dimension. Attempting to change any other bound results in
an error.
Also, the logic there is screwed up. You're doing three redims on every iteration, with the first one shrinking the second dimension back to zero on every iteration. Even if you weren't changing the first dimension, that would lose the data that you stored in AllRecrods( n ,1) because the preserve option can't keep data in a dimension that you shrink below the size that you've already used!
You should probably consider swapping your two dimensions, reversing them in your assignments, keeping the first dimension constant at 2, and eliminating two of your ReDim Preserve statements. I.e., just do one ReDim Preserve AllRecrods(2,counter) on each iteration of the loop.

How to reference an array and write to another array with more than one column per iteration

I am curious if I can copy multiple columns to a new array from an existing array in one iteration of a loop. Suppose we have the following general example:
Array1 contains 10,000 elements in column1, 10,000 elements in column2, and 10,000 elements in column 3, etc.
Let's say that I want a new array generated off that information, only I want only columns 1 and 2 populated. Can I do this by looping only once with a correctly dimensioned target array? For instance:
'Assume TargetArray has already been ReDimmed to the size of Array1 in the code prior
For i=0 to UBound(Array1)
TargetArray(x,1)= Array1(x,1)
TargetArray(x,2)=Array1(x,2)
Next
So can this be done in one step, or do I have to make a loop for each dimension I want to add to the array. Is there any speed savings by doing two operations per loop as stated above (assuming it works).
Thanks for all of your help!
Have you tried just using Range objects? I just made 100 values in columns A and B, and copy them to F and G. Or are you trying to plug values from the first three columns into an equation to give you values for the new two columns?
Sub CopyRange()
Dim Array1 As Range
Dim Array2 As Range
Set Array1 = Range("A1:B100")
Set Array2 = Range("F1:G100")
Array2.Value = Array1.Value
End Sub
Your example should work as what RubberDuck commented.
It is similar in below example which works at my end.
I can't fit it to comments so I have no choice to post it as answer.
Dim TargetArray ' declared as Variant type, not array of variants
ReDim TargetArray(0 To Ubound(Array1, 0), 0 To 1) ' for 2 columns
For i = 0 To Ubound(Array1, 1)
TargetArray(i, 0) = Array1(i, 0)
TargetArray(i, 1) = Array1(i, 1)
Next
Is this close to what you have? If so, then that should work.

Excel VBA: Replace first row by an array

I have a first row with 100 cells and I created an Array of Strings, which represent the new row content.
I would like to replace the content of all the first row with the content of my Array in VBA, how can I do that?
Say your array is called myArray, it's enough to do this:
For j = LBound(myArray) To UBound(myArray)
Sheets("your sheet").Cells(1,j+1).Value = myArray(j)
Next j
The functions LBound() and UBound() are respectively returning the first and the last index of your array.
Please note that when writing Cells(1,j+1) I'm assuming two important things:
1) Your start index starts with 0, so I want to start the insertion of the values from the column 1 (j+1 = 0+1 = 1).
2) You want to override the first row (because the row index is equal to 1).
You might want to customize this, for example creating independent indexes - when I say "independent", I mean "not depending on the lower and the upper bound of your array, nor being hard-coded like I did for the "row 1".
You can read and write between a Range and an Array in one line. It is more efficient than using a loop.
Note: The array must be 2 Dimensional to write to a range.
Public Sub ReadToArray()
' Create dynamic array
Dim StudentMarks() As Variant
' Read values into array from 100 cells in row 1
StudentMarks = Sheets("Sheet1").Range("A1:CV1").Value
' Do something with array
' Write the values back to sheet
Sheets("Sheet1").Range("A1:CV1").Value = StudentMarks
End Sub

Resources