Generating two arrays, filled for example purposes with a column of ones. We know that scalar(dot) product will be the sum of the cross-products i.e. = dimension of the column. Why must we Dim and then ReDim the variables "xDim"? Is there a more efficient way to set up array computation?
Function OnesArray(xInput As Integer)
Dim xDim() As Variant
ReDim xDim(1 To xInput, 1)
Dim i As Long
For i = 1 To xInput Step 1
xDim(i, 1) = 1
Next i
Dim TempArrayA() As Variant
Dim TempArrayB() As Variant
ReDim TempArrayA(LBound(xDim) To UBound(xDim))
ReDim TempArrayA(LBound(xDim) To UBound(xDim))
TempArrayA = xDim
TempArrayB = xDim
OnesArray = Application.WorksheetFunction.SumProduct(TempArrayA, TempArrayB)
End Function
The output produced is: Input 1, 2, 3. Output 1, 2, 3. Expected output
Related
I was trying to take some values from an excel sheet, to then process them, and I decided to use a Dynamic array, because I thought that it would be easier.
Dim Dias() As Variant
Dim Horas() As Variant
Dim Temp() As Variant
Dim Hum() As Variant
Sheets("Tfinal").Activate
Dias = Range("A2:A1745")
Horas = Range("B2:B1745")
Temp = Range("J2:J1745")
Sheets("Hfinal").Activate
Hum = Range("D2:D1745")
Dim TempNTemp() As Double
Dim NTemp() As Double
Dim NDias() As Variant
Dim NHoras() As Variant
Dim TempNHum() As Variant
Dim NHum() As Variant
Until here everything's fine, but the next line throws subscript out of range error. I'm really confused.
H = Horas(0)
Getting values from a range of cells always results in a 2-D array with a 1-based index. If you use a number of cells in a single column you still get a 1 to x, 1 to 1 array; if you use a number of cells in a single row you will get a 1 to 1, 1 to x array.
Your arrays are LBound/UBound/Ranked as follows:
Dias = Range("A2:A1745") 1 to 1744, 1 to 1
Horas = Range("B2:B1745") 1 to 1744, 1 to 1
Temp = Range("J2:J1745") 1 to 1744, 1 to 1
Hum = Range("D2:D1745") 1 to 1744, 1 to 1
So to access the first element of the first rank Horas array use one of the following:
Horas(1, 1)
Horas(LBound(Horas, 1), 1)
Truth be told, the default for the second rank is 1 so it is unnecessary. These will work just as well.
Horas(1)
Horas(LBound(Horas))
However, using that shorthand can cause confusion if you had more than a single second rank.
Horus = Range("A1:G1")
'first element
Horas(1, 1)
Horas(1, LBound(Horas, 2))
'second element
Horas(1, 2)
Setting a Watch on the array var will show you the dimensions as well as the contents.
I also use the following code within the procedure to visually see the array's dimensions in the Immediate window.
debug.print lbound(Horus, 1) & ":" & ubound(Horus, 1)
debug.print lbound(Horus, 2) & ":" & ubound(Horus, 2)
'results for Horus
1:1744
1:1
I am trying to calculate the count of Unique values based on a condition.
For example,
For a value in column B, I am trying to count the Unique values in Column C through VBA.
I know how to do it using Excel formula -
=SUMPRODUCT((B2:B12<>"")*(A2:A12=32)/COUNTIF(B2:B12,B2:B12))
that value for 32 is dynamic - Programmatically I am calling them inside my vba code as Name
This is my code :
Application.WorksheetFunction.SumProduct((rng <> "") * (rng2 = Name) / CountIfs(rng, rng))
This is the sample data with the requirement
Alternatively, I Concatenated both the columns for keeping it simple and hoping to identify the Unique values which starts with name* method.
I don't know where I am going wrong. Kindly share your thoughts.
You may try something like this...
Function GetUniqueCount(Rng1 As Range, Lookup As String) As Long
Dim x, dict
Dim i As Long, cnt As Long
Set dict = CreateObject("Scripting.Dictionary")
x = Rng1.Value
For i = 1 To UBound(x, 1)
If x(i, 1) = Lookup Then
dict.Item(x(i, 1) & x(i, 2)) = ""
End If
Next i
GetUniqueCount = dict.Count
End Function
Then you can use it like below...
=GetUniqueCount($A$2:$B$10,C2)
Where A2:B10 is the data range and C2 is the name criteria.
I'd put the values into an array, create a temporary 2nd array and only add values to this array if they are not already present, and then replace the original array. Then it's just a simple matter to sum the unique values:
Sub Unique
dim arr(10) as variant, x as variant
dim arr2() as variant
for x = 1 to 10 ' or whatever
arr(x) = cells(x, 1) ' or whatever
next x
arr2 = UniqueValuesArray(arr)
' now write some code to count the unique values, you get the idea
End Sub
Function UniqueValuesArray(arr As Variant) As Variant()
Dim currentRow, arrpos As Long
Dim uniqueArray() As Variant
Dim x As Long
arrpos = 0
ReDim uniqueArray(arrpos)
For x = 0 To UBound(arr)
If UBound(Filter(uniqueArray, arr(x))) = -1 Then
ReDim Preserve uniqueArray(arrpos)
uniqueArray(arrpos) = arr(x)
arrpos = arrpos + 1
End If
Next x
UniqueValuesArray = uniqueArray
End Function
Apologies for the newbie question, but I couldn't find an answer when searching.
I'm fairly new to matrix manipulation in VBA. I keep on getting a type mismatch with the following code.
Sub matrixtest()
Dim matrix1() As Integer
Dim matrix2() As Integer
Dim matrix3() As Integer
Dim i, j, k As Integer
'populate matrix1
ReDim matrix1(3, 3)
For j = 1 To 3
For i = 1 To 3
matrix1(i, j) = Range("C5").Offset(i - 1, j - 1)
Next i
Next j
'populate matrix2
ReDim matrix2(3, 3)
For j = 1 To 3
For i = 1 To 3
matrix2(i, j) = Range("G5").Offset(i - 1, j - 1)
Next i
Next j
ReDim matrix3(3, 3)
matrix3 = Application.WorksheetFunction.MMult(matrix1, matrix2)
End Sub
If you replace the line
matrix3 = Application.WorksheetFunction.MMult(matrix1, matrix2)
By
Debug.Print TypeName(matrix3 = Application.WorksheetFunction.MMult(matrix1, matrix2))
The output is:
Variant()
Which can't be assigned to an Integer().
I would recommend replacing
Dim matrix1() As Integer
Dim matrix2() As Integer
Dim matrix3() As Integer
Dim i, j, k As Integer
by
Dim matrix1, matrix2, matrix3 As Variant 'note lack of ()
Dim i, j, k As Long 'Integer is borderline obsolete in VBA
Variants do a nice job of holding and passing arrays and tend to handle any needed type conversions automatically. When dealing with arrays in VBA, I tend to use them almost exclusively. For one thing, it makes it easy to load arrays from ranges.
Just use ReDim to make the variants hold arrays:
ReDim matrix1(1 to 3, 1 to 3) 'doesn't hurt to be explicit about lower bounds
ReDim matrix2(1 to 3, 1 to 3)
'load arrays...
'no need to redim matrix3, just:
matrix3 = Application.WorksheetFunction.MMult(matrix1, matrix2)
There is an even shorter way of doing what you are trying to do:
matrix1 = Range("C5:E7").Value
matrix2 = Range("G5:I7").Value
matrix3 = Application.WorksheetFunction.MMult(matrix1, matrix2)
In the above code you don't need to use any preliminary ReDim. When you want to load the values of a rectangular range into a variant in VBA, you don't need to loop, which is needlessly slow. Just assign the values in one fell swoop.
I am trying to use code of the following form to populate an array of x rows:
Dim myarray() As Variant
Dim string1 As String
Dim myarray_ubound As Integer
myarray_ubound = 0
For i = 1 to x
myarray_ubound = myarray_ubound + 1
ReDim Preserve myarray(1 To myarray_ubound, 1 To 2)
myarray(myarray_ubound,1) = i
myarray(myarray_ubound,2) = string1
Next i
However, when I run it it gets stuck after the first loop, telling me that a subscript is out of range. Debugging takes me to the ReDim command.
I used myarray_ubound as an alternative to calling the UBound function many times, but I have tried using this as well and I get the same error.
Can anyone spot what's gone wrong?
See: http://msdn.microsoft.com/en-us/library/aa266231.aspx
"If you use the Preserve keyword, you can resize only the last array dimension and you can't change the number of dimensions at all."
Try
ReDim Preserve myarray(1 To 2, 1 To myarray_ubound)
instead.
you can only redim the last element of the array (not the first), see below. As you know x I would suggest to redim your array with this value from the beginning.
Dim myarray() As Variant
Dim string1 As String
Dim myarray_ubound As Integer
myarray_ubound = 0
For i = 1 To 10
myarray_ubound = myarray_ubound + 1
ReDim Preserve myarray(1 To 2, 1 To myarray_ubound)
myarray(1, myarray_ubound) = i
myarray(2, myarray_ubound) = string1
Next i
Since you are declaring the variable as a Variant i don't see why you need to re-dim. (maybe related to memory issues, feel free to fill in).
I would suggest:
For i = 1 to 10
myArray(1, i-1) = i
myArray(2, i-1) = string1
next i
I am pulling out values from a variable number of sheets within excel (fifth to third from last), each of which contains a variable number of "entries". E.G. "Entry 1" has values I want in columns F and H. "Entry 2" has values I want in columns K and M, etc. (These are also referred to as "quotes" in the comments for the code).
I'm using a For loop within a For loop to accomplish this. The issue I'm having is that each recursion of the "parent" for loop is over-writing the entries created in the previous recursion. My code illustrates:
Sub ListSheets()
' Creating an integer that specifies the size of the arrays of column entries
' and thus the maximum number of quotes.
Dim array_size As Integer
'Defining Arrays that will be used to select quantities of different quotes
'(e.g. Class)
'Region, Date and Price all have the same column entries, meaning only one array is
'required.
Dim Class_Cols_Array() As Integer
Dim RDP_Cols_Array() As Integer
'Resizing these arrays. This resize sets the maximum number of quotes per sheet to
'1000.
array_size = 1000
ReDim Class_Cols_Array(1 To array_size, 1 To 1)
ReDim RDP_Cols_Array(1 To array_size, 1 To 1)
'Setting the first entries as the corresponding column indexes of H and F
'respectively.
Class_Cols_Array(1, 1) = 8
RDP_Cols_Array(1, 1) = 6
' Filling both arrays with column indexes of quotes. In both cases the row number is
'the same for each quote and thus
' does not need to be specified for each entry.
For intLoop = 2 To 1000
Class_Cols_Array(intLoop, 1) = Class_Cols_Array(intLoop - 1, 1) + 5
RDP_Cols_Array(intLoop, 1) = RDP_Cols_Array(intLoop - 1, 1) + 5
Next
'Defining an array which will contain the number of entries/quotes (as defined by
' the user) for each sheet/manufacturer.
Dim Num_of_Entries() As Integer
' Resizing this array to match the number of manufacturers (sheets therein) within
'the workbook.
ReDim Num_of_Entries(1 To Worksheets.Count - 6, 1 To 1)
'Defining arrays that will contain will be populated with quote quantities (e.g.
'Class), pulled from cells.
Dim Class_Array() As String
Dim Region_Array() As String
Dim Date_Array() As String
Dim Price_Array() As String
Dim Manufacturer_Array() As String
'Here number of entries for each manufacturer (sheet) are pulled out, with this
'value being entered into the appropriate cell(B5)
'by the user.
Dim i As Integer
For i = 5 To Worksheets.Count - 2
j = i - 4
Num_of_Entries(j, 1) = ThisWorkbook.Worksheets(i).Cells(5, 2)
Next
'Creating an integer that is the total number of entries (that for all sheets
'combined).
Dim total_entries As Integer
total_entries = WorksheetFunction.Sum(Num_of_Entries)
'Setting the size of each quantity-containing array to match the total number of
'entries.
ReDim Class_Array(1 To total_entries, 1 To 1)
ReDim Region_Array(1 To total_entries, 1 To 1)
ReDim Date_Array(1 To total_entries, 1 To 1)
ReDim Price_Array(1 To total_entries, 1 To 1)
ReDim Manufacturer_Array(1 To total_entries, 1 To 1)
'Creating a variable for the numbers of entries for a specific sheet.
Dim entries_for_sheet As Integer
'Creating a variable for the sheet number for a specific sheet (e.g. "Acciona_Fake
'is the 5th sheet).
Dim sheet_number As Integer
'Looping over the sheets (only fifth to third from last sheets are of interest).
For sheet_number = 5 To Worksheets.Count - 2
'Creating an iterating value that starts at 1 in order to match sheets to their
'number of entries.
j = sheet_number - 4
entries_for_sheet = Num_of_Entries(j, 1)
'Looping over the entries for each sheet, extracting quote quantities and adding
'to their respective arrays.
For i = 1 To entries_for_sheet
Class_Array(i, 1) = ThisWorkbook.Worksheets(sheet_number).Cells(6,
Class_Cols_Array(i, 1))
Region_Array(i, 1) = ThisWorkbook.Worksheets(sheet_number).Cells(6,
RDP_Cols_Array(i, 1))
Date_Array(i, 1) = ThisWorkbook.Worksheets(sheet_number).Cells(8,
RDP_Cols_Array(i, 1))
Price_Array(i, 1) = ThisWorkbook.Worksheets(sheet_number).Cells(41,
RDP_Cols_Array(i, 1))
Manufacturer_Array(i, 1) = ThisWorkbook.Worksheets(sheet_number).Name
Next
Next
'Exporting all arrays.
Sheets("vba_deposit").Range("A1").Resize(UBound(Class_Array)).Value = Class_Array
Sheets("vba_deposit").Range("B1").Resize(UBound(Region_Array)).Value = Region_Array
Sheets("vba_deposit").Range("C1").Resize(UBound(Date_Array)).Value = Date_Array
Sheets("vba_deposit").Range("D1").Resize(UBound(Price_Array)).Value = Price_Array
Sheets("vba_deposit").Range("D1").Resize(UBound(Manufacturer_Array)).Value =
Manufacturer_Array
End Sub
Looking at the for loop within a for loop at the bottom, I need to find a way to keep the iteration of the RHS of the equation(s). E.G. I need the i value to be the same for,
ThisWorkbook.Worksheets(sheet_number).Cells(6, Class_Cols_Array(i, 1))
whereas I need the i on the LHS of the equation to also increase with each run of the "parent" for loop. I.E. I need the i to be the "number of entries thus far" + i for
ThisWorkbook.Worksheets(sheet_number).Cells(6, Class_Cols_Array(i, 1))
I can't figure out a way to do this. Is there perhaps a way to append an array rather than assigning values to individual elements? (This sounds really simple but I've searched and not been able to find a genuine append method, only loops of assigning to elements).
Many thanks in advance.
Compiled but not tested:
Sub ListSheets()
Dim intLoop As Long, i As Long, total_entries As Long
Dim sht As Worksheet, sheet_number As Long
Dim entries_for_sheet As Long
Dim classCol As Long, RDPCol As Long
Dim entry_num As Long
Dim Data_Array() As String
total_entries = 0
entry_num = 0
For sheet_number = 5 To Worksheets.Count - 2
Set sht = ThisWorkbook.Worksheets(sheet_number)
entries_for_sheet = sht.Cells(5, 2).Value
total_entries = total_entries + entries_for_sheet
'can only use redim Preserve on the last dimension...
ReDim Preserve Data_Array(1 To 5, 1 To total_entries)
classCol = 8
RDPCol = 6
For i = 1 To entries_for_sheet
entry_num = entry_num + 1
Data_Array(1, entry_num) = sht.Cells(6, classCol)
Data_Array(2, entry_num) = sht.Cells(6, RDPCol) ' 6?
Data_Array(3, entry_num) = sht.Cells(8, RDPCol)
Data_Array(4, entry_num) = sht.Cells(41, RDPCol)
Data_Array(5, entry_num) = sht.Name
classCol = classCol + 5
RDPCol = RDPCol + 5
Next
Next
Sheets("vba_deposit").Range("A1").Resize(UBound(Data_Array, 2), _
UBound(Data_Array, 1)).Value = Application.Transpose(Data_Array)
End Sub