I've got this code:
rs1 = getResults(sSQL1)
rs2 = getResults(sSQL2)
rs1 and rs2 and 2D arrays. The first index represents the number of columns (static) and the second index represents the number of rows (dynamic).
I need to join the two arrays and store them in rs3. I don't know what type rs1 and rs2 are though.
Are you sure that the columns will match up? Because if that's not the case I don't know how you'd do it in a generic way in any language. If it is the case, then you could probably do it very simply like this:
rs1 = getResults(sSQL1 & " UNION " sSQL2)
I've figured it out. Turns out I was doing it the right way all along, I was just off by one. You don't need a third array either.
aRS_RU = rowsQuery(sSQL & ", 'RU'")
aRS_KR = rowsQuery(sSQL & ", 'KR'")
uboundRU1 = UBound(aRS_RU, 1)
uboundRU2 = UBound(aRS_RU, 2)
uboundKR2 = Ubound(aRS_KR, 2)
' Redim original array
ReDim Preserve aRS_RU(uboundRU1, uboundRU2 + uboundKR2 + 1 )
uboundRU2 = UBound(aRS_RU, 2)
' Add the values from the second array
For m = LBound(aRS_KR, 1) To UBound(aRS_KR, 1) 'Loop for 1st dimension
For n = LBound(aRS_KR, 2) To UBound(aRS_KR, 2) 'Loop for 2nd dimension
aRS_RU(m, uboundRU2 + n) = aRS_KR(m,n)
Next
Next
I know this post is old, but I adapted the code to fix some errors I had during its execution. The following code sample works for me:
Sub ConcatRecordSets(ByRef avFirstRS As Variant, ByRef avSecondRS As Variant)
Dim lIndex1 As Long, lIndex2 As Long
Dim lFirstRSSize As Long, lSecondRSSize As Long
' Redim original array
lFirstRSSize = UBound(avFirstRS, 2) - LBound(avFirstRS, 2) + 1
lSecondRSSize = UBound(avSecondRS, 2) - LBound(avSecondRS, 2) + 1
ReDim Preserve avFirstRS(LBound(avFirstRS, 1) To UBound(avFirstRS, 1), LBound(avFirstRS, 2) To UBound(avFirstRS, 2) + lSecondRSSize)
' Add the values from the second array
For lIndex1 = LBound(avSecondRS, 1) To UBound(avSecondRS, 1) ' Loop for 1st dimension
For lIndex2 = LBound(avSecondRS, 2) To UBound(avSecondRS, 2) ' Loop for 2nd dimension
avFirstRS(lIndex1, lFirstRSSize + lIndex2) = avSecondRS(lIndex1, lIndex2)
Next lIndex2
Next lIndex1
End Sub
Related
I have an array with 2 dimensions.
I also have a For Each loops which loops with elements of these arrays.
How can i get a Index of vElement/vElement2 in the moment of my comment here in code?
I would be very, very thankful if You can help me.
For Each vElement In Table1
For Each vElement2 In Table2
If ws_1.Cells(1, c) = vElement Then
For Row = 3 To lastRow
amountValue = amountValue + ws_1.Cells(Row, c).value
ws_2.Cells(row2, colIlosc) = amountValue
'Here i would love to have index of vElement for example. In my head it would be something like... Index(vElement) or Index(Table1(vElement))
ws_2.Cells(row2, columncodeprod) = vElement2
row2 = row2 + 1
amountValue = 0
Next Row
End If
Next vElement2
Next vElement
Show Indices of an element in a 2-dim Array - the complicated way
If I understand correctly, you are looping through a datafield array via a ►For Each construction and want to get the current row/column index pair of that same array.
In order to answer your question
"How to get indices of an element in a two dimensional array",
I leave aside that you would get these automatically in a more evident and usual way if you changed the logic by looping through array rows first and inside this loop eventually through array columns - see Addendum *).
To allow a reconstruction of e.g. the 6th array element in the example call below as referring to the current index pair (element i=6 ~> table1(3,2) ~> row:=3/column:=2) it would be necessary
to add an element counter i by incrementing its value by +1 each time you get the next element and
to pass this counter as argument (additionally to a reference to the datafield) to a help function getIndex()
returning results as another array, i.e. an array consisting only of two values: (1) the current array row, (2) the current array column:
Example call
Note: For better readibility and in order to condense the answer to the mimimum needed (c.f. MCVE) the following example call executes only one For Each loop over the table1 datafield array; you will be in the position to change this to your needs or to ask another question.
Option Explicit ' declaration head of your code module
Sub ShowIndicesOf2DimArray()
Dim table1 ' declare variant 1-based 2-dim datafield
table1 = Sheet1.Range("A2:B4") ' << change to sheets Code(Name)
Dim vElem, i As Long
Dim curRow As Long, curCol As Long ' current row/column number
For Each vElem In table1
i = i + 1 ' increment element counter
curRow = getIndex(table1, i)(1) ' <~ get row index via help function
curCol = getIndex(table1, i)(2) ' <~ get col index via help function
'optional debug info in VB Editors immediate window (here: Direktbereich)
Debug.Print i & ". " & _
" Table1(" & curRow & "," & curCol & ") = " & vElem & vbTab;
Debug.Print ", where curRow|curCol are " & Join(getIndex(table1, i), "|")
Next vElem
End Sub
Help function getIndex() called by above procedure
Function getIndex(table1, ByVal no As Long) As Variant
'Purpose: get 1-based 1-dim array with current row+column indices
ReDim tmp(1 To 2)
tmp(1) = (no - 1) Mod UBound(table1) + 1
tmp(2) = Int((no - 1) / UBound(table1) + 1)
getIndex = tmp
End Function
*) Addendum - "the simple way"
Just the other way round using row and column variables r and c as mentioned above; allows to refer to an item simply via table1(r,c) :
Sub TheSimpleWay()
Dim table1 ' declare variant 1-based 2-dim datafield
table1 = Sheet1.Range("A2:B4") ' << change to sheets Code(Name)
Dim vElem, i As Long
Dim r As Long, c As Long ' row and column counter
For r = 1 To UBound(table1) ' start by row 1 (1-based!) up to upper boundary in 1st dimension
For c = 1 To UBound(table1, 2) ' start by col 1 (1-based!) up to upper boundary in 2nd dimension
i = i + 1
Debug.Print i & ". " & _
" Table1(" & r & "," & c & ") = " & table1(r, c) & vbTab;
Debug.Print ", where row|col are " & r & "|" & c
Next c
Next r
End Sub
There is NO index in the case you put in discussion...
vElement and vElement2 variables are of the Variant type. They are not objects, to have an Index property.
When you use a For Each vElement In Table1 loop, VBA starts from the array first element, goes down up to the last row and then do the same for the next column.
When you need to know what you name arrays 'indexes' you must use For i = 1 To Ubound(Table1, 1) followed by For j = 1 To Ubound(Table1, 2). In such a case you will know the matching array element row and columns. We can consider them your pseudo-indexes...
If you really want/insist to extract such indexes in an iteration of type For Each vElement In Table1, you must build them. I will try en elocvent code example:
Sub testElemIndex()
Dim sh As Worksheet, Table1 As Variant, vElement As Variant
Dim i As Long, indexRow As Long, indexCol
Set sh = ActiveSheet
sh.Range("C6").value = "TestIndex"
Table1 = sh.Range("A1:E10").value
For Each vElement In Table1
i = i + 1:
If vElement = "TestIndex" Then
If i <= UBound(Table1, 1) Then
indexRow = i: indexCol = 1
Else
indexCol = Int(i / UBound(Table1, 1)) + 1
indexRow = i - Int(i / UBound(Table1, 1)) * UBound(Table1, 1)
End If
Debug.Print Table1(indexRow, indexCol), indexRow, indexCol: Stop
End If
Next
End Sub
You can calculate the rows and columns of the array element. And the code proves that using them, the returned array value is exactly the found one...
Is it a little more light on the array 'indexes'...?
Dim Table1() As Variant
Dim Table2() As Variant
Table1 = Range(Cells(2, 3), Cells(lastRow, vMaxCol))
Table2 = Range(Cells(2, 1), Cells(lastRow, 1))
Table1 is Variant(1 to 33, 1 to 9)
Table2 is Variant(1 to 33, 1 to 1)
This 33 and 9 is dynamic.
I am trying to build a subroutine which checks a certain condition in a client list, separates out the entries which meets the condition, and then average the remaining entries for each name. It is like a doing a pivot table with VBA. I did not want to use the pivot table, since writing the data into a new sheet, refresh it and do something with it adds an unnecessary burden on the speed of the tool. Furthermore, all the arrays are to be kept within the code, rather than written on the sheets. I am almost done with the code, but it is giving me an error in the very end, where I am using the sumif condition.
A point of clarification: The argument 'Number' is a global variable declared in the main tool, which comes from the count of names from the main list, which is in sheet5. I hope that the code is self explanatory beyond that.
What I am getting while running the code is the Error- Run-time error '1004':
Method 'Range' of object '_Global' failed on the line TaskArray(k, 1) = Application.WorksheetFunction.SumIf(Range(Names), NewList(k), Range(ParameterB))
The Code-
Sub Task()
Dim Names() As Variant 'Declare Names
ReDim Names(0 To Number) As Variant 'Declare Names as a vector
Dim ParameterA() As Variant 'Declare Parameter A
ReDim ParameterA(0 To Number) As Variant 'Declare Parameter A as a vector
Dim ParameterB() As Variant 'Declare Parameter B
ReDim ParameterB(0 To Number) As Variant 'Declare Parameter B as a vector
Dim i As Integer
For i = 1 To Number
Select Case Sheet5.Range("BO" & i + 1) - Sheet5.Range("BN" & i + 1)
Case 0
Names(i) = ""
ParameterA(i) = Sheet5.Range("BN" & i + 1) - Sheet5.Range("BL" & i + 1)
ParameterB(i) = ""
Case Else
Names(i) = Sheet5.Range("F" & i + 1)
ParameterA(i) = Sheet5.Range("BN" & i + 1) - Sheet5.Range("BL" & i + 1)
ParameterB(i) = Sheet5.Range("BO" & i + 1) - Sheet5.Range("BN" & i + 1)
End Select
Next i
Sheet3.Range("T159") = Application.WorksheetFunction.Sum(ParameterA()) 'Write the total of Parameter A
Sheet3.Range("T160") = Application.WorksheetFunction.Sum(ParameterB()) 'Write the total of Parameter B
'________________________ To isolate the list of Names (Unique) with existent Parameter B
Dim NewList() As Variant
Dim j As Long
Dim d As Scripting.Dictionary
Set d = New Scripting.Dictionary
With d
For j = LBound(Names) To UBound(Names)
If IsMissing(Names(j)) = False Then
.item(Names(j)) = 1
End If
Next
NewList = .Keys
End With
'________________________To create an array of sums of Parameter B
For k = 1 To Application.WorksheetFunction.CountA(NewList) - 1
Dim TaskArray() As Variant
ReDim TaskArray(1 To k, 0 To 1) As Variant
ReDim Names(0 To Number) As Variant
ReDim ParameterB(0 To Number) As Variant
TaskArray(k, 0) = NewList(k)
TaskArray(k, 1) = Application.WorksheetFunction.SumIf(Range(Names), NewList(k), Range(ParameterB))
Sheet19.Range("H" & k + 1) = TaskArray(k, 0)
Sheet19.Range("I" & k + 1) = TaskArray(k, 1)
Next k
End Sub
I am populating a listbox in a form using a range as so:
Private Sub UserForm_Initialize()
Names = Range("C6:D" & Cells(Rows.Count, 3).End(xlUp).Row)
For i = LBound(Names, 1) To UBound(Names, 1)
ListBox1.AddItem Names(i, 1) & "-" & Names(i, 2)
Next
OptionButton3.Value = True
End Sub
I need to call the address of each of these items later in my code to act upon; in reality each item in the listbox is to select which rows to act upon by the user placing each item in a different listbox as part of the form.
I have tried to redimension the array like so, with no success due to "Constant Expression Required":
Dim Names(6 To Cells(Rows.Count, 3).End(xlUp).Row, Range("C6:D" & Cells(Rows.Count, 3).End(xlUp).Row))
What is either the best way to associate the address with the array, or record the list of rows ?
Think this is what you need:
Code
Private Sub UserForm_Initialize()
' I. Get started
' a) variables
Const iOffset As Long = 5 ' row offset 5, i.e. start at row C6
Dim names, a ' variant datafield arrays
Dim i As Long, n As Long
Dim ws As Worksheet
' b) set worksheet object to memory
Set ws = ThisWorkbook.Worksheets("MySheet") ' << change to your sheet name
' c) listbox layout just for demo
Me.ListBox1.ColumnCount = 2
Me.ListBox1.ColumnWidths = "100;50"
' d) get last row of column C
n = ws.Cells(Rows.Count, 3).End(xlUp).Row
' II. Get values
' a) create 1-based 2-dim variant datafield array
names = ws.Range("C6:D" & n)
' b) concatenate names and define cell address
For i = LBound(names, 1) To UBound(names, 1)
names(i, 1) = names(i, 1) & "-" & names(i, 2)
names(i, 2) = "C" & i + iOffset
Next
' III. Fill Listbox
' get values of names array (1-liner, allows more than 10 columns :-)
ListBox1.List = names
' IV. Test to get 2nd array column into new array a
a = Application.Index(names, 0, 2)
For i = LBound(a) To UBound(a)
Debug.Print a(i, 1)
Next i
' V. clear memory
Set ws = Nothing
End Sub
Note
I added a constant defining your row Offset (Const iOffset As Long = 5) and speeded up code using an array assignment to your ListBox.List in one code statement instead of adding items one by one (BTW this would allow to use more than 10 listbox columns).
As #Rory remarked, just adding your row offset (e.g. +5) to the current active ListBox1.Listindex would be sufficient to get the row number. In this case you should only take care that a list row is marked (i.e. to check If ListBox1.ListIndex > -1 Then ... do something).
I solved the problem by a rather inelegant hack that I don't particularly like using a helper column listing the row number. There are better ways of doing this I'm sure, but here's what I came up with:
Private Sub UserForm_Initialize()
Names = Range("C6:E" & Cells(Rows.Count, 3).End(xlUp).Row)
For i = LBound(Names, 1) To UBound(Names, 1)
ListBox1.AddItem Names(i, 3) & ": " & Names(i, 1) & "-" & Names(i, 2)
Next
OptionButton3.Value = True
End Sub
I then recall the row number in my code as follows once the user has selected which items to act on:
For i = 0 To (ListBox2.ListCount - 1)
Dim itemName() As String
itemName() = Split(ListBox2.list(i), ":")
deviceRow = itemName(0)
Debug.Print "Row number: " + deviceRow
... <SNIP>
It Prints like this:
Row number: 10
Row number: 7
Row number: 14
Row number: 9
There must be better ways of doing this, but that was my solution.
I have a simple excel UDF for converting an array of mass values to mol fractions. Most times, the output will be a column array (n rows by 1 column).
How, from within the VBA environment, do I determine the dimensions of the target cells on the worksheet to ensure that it should be returned as n rows by 1 column versus n columns by 1 row?
Function molPct(chemsAndMassPctsRng As Range)
Dim chemsRng As Range
Dim massPctsRng As Range
Dim molarMasses()
Dim molPcts()
Set chemsRng = chemsAndMassPctsRng.Columns(1)
Set massPctsRng = chemsAndMassPctsRng.Columns(2)
chems = oneDimArrayZeroBasedFromRange(chemsRng)
massPcts = oneDimArrayZeroBasedFromRange(massPctsRng)
'oneDimArrayZeroBasedFromRange is a UDF to return a zero-based array from a range.
ReDim molarMasses(UBound(chems))
ReDim molPcts(UBound(chems))
totMolarMass = 0
For chemNo = LBound(chems) To UBound(chems)
molarMasses(chemNo) = massPcts(chemNo) / mw(chems(chemNo))
totMolarMass = totMolarMass + molarMasses(chemNo)
Next chemNo
For chemNo = LBound(chems) To UBound(chems)
molPcts(chemNo) = Round(molarMasses(chemNo) / totMolarMass, 2)
Next chemNo
molPct = Application.WorksheetFunction.Transpose(molPcts)
End Function
I understand that, if nothing else, I could have an input parameter to flag if return should be as a row array. I'm hoping to not go that route.
Here is a small example of a UDF() that:
accepts a variable number of input ranges
extracts the unique values in those ranges
creates a suitable output array (column,row, or block)
dumps the unique values to the area
Public Function ExtractUniques(ParamArray Rng()) As Variant
Dim i As Long, r As Range, c As Collection, OutPut
Dim rr As Range, k As Long, j As Long
Set c = New Collection
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' First grab all the data and make a Collection of uniques
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
For i = LBound(Rng) To UBound(Rng)
Set r = Rng(i)
For Each rr In r
c.Add rr.Value, CStr(rr.Value)
Next rr
Next i
On Error GoTo 0
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' next create an output array the same size and shape
' as the worksheet output area
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
k = 1
With Application.Caller
ReDim OutPut(1 To .Rows.Count, 1 To .Columns.Count)
End With
For i = LBound(OutPut, 1) To UBound(OutPut, 1)
For j = LBound(OutPut, 2) To UBound(OutPut, 2)
If k < c.Count + 1 Then
OutPut(i, j) = c.Item(k)
k = k + 1
Else
OutPut(i, j) = ""
End If
Next j
Next i
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' put the data on the sheet
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ExtractUniques = OutPut
End Function
You should return two dimensional arrays: n × 1 for row and 1 × n for column vectors.
So you need either
Redim molPcts(1, Ubound(chems) + 1)
or
Redim molPcts(Ubound(chems) + 1, 1)
To refer to them, you need to use both indices:
molPcts(1, chemNo + 1)
or
molPcts(chemNo + 1, 1)
If you prefer 0-based arrays, the redim should be like this:
Redim molPcts(0 To 0, 0 To Ubound(chems))
Redim molPcts(0 To Ubound(chems), 0 To 0)
There has to be a simpler way to do this. I took the advice of one poster on this forum who said that I have to set my multidimensional array to a high number then redimension it to a lower number. But in order to get it to the right number I have to run it through two loops where it seems like there has to be a simpler way to do things. So I have the array ancestors which has several blanks in it which I'm trying to get rid of. The second dimension will always be 2. I first run it through a loop to determine the ubound of it. And I call that ancestors3. Then I run the ancestors3 array through a loop and populate the ancestors2 array.
For s = 1 To UBound(ancestors, 1)
temp_ancest = ancestors(s, 1)
If temp_ancest <> "" Then
uu = uu + 1
ReDim Preserve ancestors3(uu)
ancestors3(uu) = temp_ancest
End If
Next
Dim ancestors2()
ReDim ancestors2(UBound(ancestors3), 2)
For s = 1 To UBound(ancestors3, 1)
temp_ancest = ancestors(s, 1)
temp_ancest2 = ancestors(s, 2)
If temp_ancest <> "" Then
y = y + 1
ancestors2(y, 1) = temp_ancest
ancestors2(y, 2) = temp_ancest2
End If
Next
Reading your question i think you want this:
you have a 2D array ancestors that may have some blank entries in the 1st dimension
you want a copy of ancestors without those blank rows, called ancestors2
Here is one way to do this. See inline comments for explanation
Sub Demo()
Dim ancestors As Variant
Dim ancestors2 As Variant
Dim i As Long, j As Long
Dim LB as long
' Populate ancestors as you see fit
'...
' crate array ancestors2, same size as ancestors, but with dimensions flipped
' so we can redim it later
ReDim ancestors2(LBound(ancestors, 2) To UBound(ancestors, 2), _
LBound(ancestors, 1) To UBound(ancestors, 1))
' Loop ancestors array, copy non-blank items to ancestors2
j = LBound(ancestors, 1)
LB = LBound(ancestors, 1)
For i = LBound(ancestors, 1) To UBound(ancestors, 1)
If ancestors(i, 1) <> vbNullString Then
ancestors2(LB, j) = ancestors(i, LB)
ancestors2(LB + 1, j) = ancestors(i, LB + 1)
j = j + 1
End If
Next
' Redim ancestors2 to match number of copied items
ReDim Preserve ancestors2(LBound(ancestors2, 1) To UBound(ancestors2, 1), _
LBound(ancestors2, 2) To j - 1)
' Transpose ancestors2 to restore flipped dimensions
ancestors2 = Application.Transpose(ancestors2)
End Sub