Can't write array to sheet - excel

Dim HighScoreOneHourData() As Integer
Dim HighScoreOneHourDates() As String
ReDim HighScoreOneHourData(1 To UBound(SA, 1) - 3)
ReDim HighScoreOneHourDates(1 To UBound(SA, 1) - 3)
For j = 4 To UBound(SA, 1)
HighScoreOneHourData(j - 3) = CInt(Val(SA(j, PositionInArray + DataColumn + 2)))
HighScoreOneHourDates(j - 3) = SA(j, 1)
Next j
SortSheet.Range("A1:A" & UBound(HighScoreOneHourDates)) = HighScoreOneHourDates
SortSheet.Range("B1:B" & UBound(HighScoreOneHourData)) = HighScoreOneHourData
When these last two lines in the example above are executed all the cells in the sheets are filled with the first element from the arrays.
HighScoreOneHourDates is an array filled with consecutive dates. Still only the first date is printed to the sheet.
I've stopped the code and checked the state of the arrays and the they are correctly filled.
Anyone knows why the cells are filled with the first element?

It's been explained why 1D arrays don't work for you. A better fix is to Dim them as 2D
ReDim HighScoreOneHourData(1 To UBound(SA, 1), 1 To 1) As Integer
ReDim HighScoreOneHourDates(1 To UBound(SA, 1), 1 To 1) As String
For j = 4 To UBound(SA, 1)
HighScoreOneHourData(j - 3, 1) = CInt(Val(SA(j, PositionInArray + DataColumn + 2)))
HighScoreOneHourDates(j - 3, i) = SA(j, 1)
Next j
SortSheet.Range("A1:A" & UBound(HighScoreOneHourDates, 1)) = HighScoreOneHourDates
SortSheet.Range("B1:B" & UBound(HighScoreOneHourData, 1)) = HighScoreOneHourData

A 1D array always wants to be placed on a sheet in a row, not a column. That's why you only get the first element repeated. You need to re-orient the array to put it in a column, or make your arrays 2D (1 To numHere, 1 To 1)
Note there is a limit to the array size you can pass to Transpose of around 63-64k elements.
Assuming your arrays are 1-based you can do this:
SortSheet.Range("A1:A" & UBound(HighScoreOneHourDates)) = _
Application.Transpose(HighScoreOneHourDates)
for example.

Related

Is there an easy way to add a string to beginning and end of VBA array

If i have this code is there a simple way to add item1 to the beginning of the array and item2 to the end of the array in VBA?
The below code currently runs.
Dim nameArray as variant
Dim k as integer
Dim item1 as string
Dim item2 as string
k = 1
nameArray = Range(Cells(2, 3), Cells(5, 3)).Value
For Each i In nameArray
newcol = baseclmn + k
tblComp.ListColumns.Add(newcol).Name = i
k = k + 1
Next I
Thanks for any help you can offer
You could start off with a larger array and replace the first and last items.
Dim nameArray as variant
nameArray = Range(Cells(1, 3), Cells(6, 3)).Value
nameArray(LBound(nameArray), 1) = "Item1"
nameArray(UBound(nameArray), 1) = "Item2"
If you want to expand the array, perhaps something like this:
nameArray = Range(Cells(2, 3), Cells(5, 3)).Value
Dim newArray
ReDim newArray(1 to Ubound(nameArray, 1) + 2, 1 to Ubound(nameArray, 2)) 'add two rows
newArray(1, 1) = "item1"
newArray(Ubound(newArray, 1), 1) = "item2"
Dim i As Long
For i = LBound(nameArray, 1) To Ubound(nameArray, 1)
newArray(i + 1, 1) = nameArray(i, 1)
Next
Explanation:
nameArray is a 2-dimensional array, where the first dimension corresponds to rows and the second to columns. Note that this array is one-based, i.e. the first index is 1 and not 0.
The code uses ReDim to create a new array, containing
Two more rows than nameArray
The same number of columns as nameArray.
Then it adds the first and last items:
newArray(1, 1) = "item1": 1, 1 corresponds to the first row, first column.
newArray(Ubound(newArray, 1), 1) = "item2": Ubound(newArray, 1) corresponds to the last row, and 1 again corresponds to the first column.
Finally it uses a loop to read the items from nameArray into the middle of newArray.
Further helpful reading includes Arrays and Ranges in VBA.
You can enlarge (and/or restructure) the existing (vertical) nameArray in one go
via an undocumented feature of Application.Index()
using either the new Sequence() function (available since MS 365!) or a workaround via row evaluation (commented out in comment)
to pass a whole array(!) of row numbers (rowArr) as argument (instead of a single row index):
newArray = Application.Index(nameArray, rowArr, 1)
where rowArr is a vertical array of sequential row numbers reflecting the currently existing indices, and 1 the unchanged column index.
Sub TopBottomAdditions()
'0. define 1-based 2-dim data field
Dim nameArray
nameArray = Sheet1.Range(Cells(2, 3), Cells(5, 3)).Value 'i.e. data field of cells C2:C5
'1a create a sequence (array) ranging from 0 to elements count plus +1 (2 new elems)
Dim rowArr ' {0,1,2,..n,n+1}
rowArr = WorksheetFunction.Sequence(UBound(nameArray) + 2, 1, 0)
''>workaround if you don't dispose of version MS 365
' rowArr = Evaluate("row(1:" & UBound(nameArray) + 2 & ")-1")
'1b keep existing values in rows 1..n and add top+bottom element
'note: index 0 fetches element of existing index 1, n+1 gets a temporary error value
Dim newArray
newArray = Application.Index(nameArray, rowArr, 1)
'1c insert new top & bottom values
newArray(1, 1) = "Top value" ' overwrites New elem no 1
newArray(UBound(newArray), 1) = "Bottom value" ' writes New last elem
End Sub
Syntax of Sequence()
=SEQUENCE(rows,[columns],[start],[step])

classification of grouped items based on parent child hierarchy

I have several thousands of lines with parent-child hierarchies and a sample I am sharing here. The data has hierarchy levels starting from 0 to 10, but for me from level 3 and above are important as I am calculating the weight of parent level 3 which is dependant on it's child and sub child levels.
From column L to P, I have shown the hierarchy, where 3 is the parent, 4 is child and some childs 4 are then classified to 5,6,7... so on. The weight of parent 3 is sum of all 4's, where sum of 4's is again sum of 5's and so on..
I tried to initially write the parent info. of each child by putting here in C7 the following formula =IF(B7>3;IF(B7>B6;D6;C6);"")
which works fine till row 6 and then fails as the level here changes from 6 to 5. See the image below
So I realised that Excel formula will not be sufficient here to extract all the parent info. Also cell F6 is again classified based on material are again dependent on child.
could anyone please tell how to proceed with vba for extracting the parent info. and the weight classification? A few lines of code would be a great help for me to head start.
Thanks a lot in advance!
Please, test the next code. You did not answer my clarification question and the following code assumes that you did not show us the correct weight for second 5:
Sub CalculateWeight()
Dim sh As Worksheet, lastR As Long, arr, arrC, ref As Long, i As Long, j As Long, k As Long
Set sh = ActiveSheet
lastR = sh.Range("B" & sh.rows.count).End(xlUp).row
arr = sh.Range("B3:D" & lastR).Value 'put the range to be processed in an array, for faster iterations
ReDim arrC(1 To UBound(arr), 1 To 1) 'redim the final array for the same number of rows like arr
For i = 1 To UBound(arr) 'iterate between the array rows
If arr(i, 1) > 3 Then 'if the hierarchy value is > 3:
Do While (arr(i + j, 1) > 3)'loop until the next 0
ref = i - 1 'memorize the row keeping the third hierarchy
If arr(i + j, 1) = arr(i + j - 1, 1) + 1 Then 'if the value in column 1 is less with a unit thay precedent
arrC(i + j, 1) = arr(i + j - 1, 3): j = j + 1 'take the value of the precedent row, third column
Else
For k = i + j To ref Step -1 'iterate backwards
If arr(i + j, 1) = arr(k - 1, 1) + 1 Then 'when find the hierarchy less with a unit
arrC(i + j, 1) = arr(k - 1, 3): j = j + 1: Exit For 'take the value of third column and exit iteration
End If
Next k
End If
If i + j > UBound(arr) Then Exit For 'exit iteration if it exceeds the array number of elements
Loop
Else
arrC(i, 1) = "" 'for lines before each 3
End If
If j > 0 Then i = i + j - 1: j = 0 'reinitialize variables
Next i
sh.Range("C3").Resize(UBound(arrC), 1).Value = arrC 'drop the array content at once
End Sub

fill one dimensional dynamic array

I have code like this.
Dim sums() As Single
dim n as integer
For n = 0 To ActiveCell.Value - 2
sums(n) = Abs(Application.WorksheetFunction.SumIf(Range(Cells(i + m, 6), Cells(j - 1, 6)), Range("F" & i + m).Value, Range(Cells(i + m, 17), Cells(j - 1, 17))))
Next n
I am getting an error message for sums(n)= .... I would like to fill array with values according to formula. E.G I have in activecell value 3, then I would like to have array with 2 values like sums(0) = abs(sumif..) and sums(1)= abs(sumif..).
I tried to calculate the formula without an array as sum1 = formula and it worked, but as soon as I changed it to the array because sometimes I will have there 2, 3 an more values in it, it doesn't work.
try the below changes:
Option Explicit
Sub sums_()
Dim sums() As Single
Dim n As Integer
Dim i As Integer
Dim m As Integer
Dim j As Integer
'assign the values or range of values for i,m,j
ReDim sums((ActiveCell.Value - 2) + 1)
For n = 0 To ActiveCell.Value - 2
sums(n) = Abs(Application.WorksheetFunction.SumIf(Range(Cells(i + m, 6), Cells(j - 1, 6)), Range("F" & i + m).Value, Range(Cells(i + m, 17), Cells(j - 1, 17))))
Next n
End Sub
You need to size your array first. Use Redim to do so before your loop:
Redim sums(0 to ActiveCell.Value - 2)
For n = 0 To ActiveCell.Value - 2
...
You can use Redim multiple times in your code, but note that if you want to keep the content of the array, you have to use Redim preserve and that is rather slow because the complete array is rebuild. So you should avoid to use Redim preserve within a loop.

Populating multi dimensional arrays with 0

I'm trying to populate part of an array with 0's and wondering if there was a better way then to loop through it.
I know I could use Dim tempArr as double to do this but the first column in the array contains strings.
I'm currently using
Dim tempArr as Variant
ReDim tempArr(1 To 6, 1 To 1 + (EndWeek - (BeginWeek - 1)))
tempArr(1, 1) = "Monday - Friday"
tempArr(2, 1) = "Saturday"
tempArr(3, 1) = "Sunday"
tempArr(4, 1) = "Bank Holiday"
tempArr(5, 1) = "Annual Leave"
tempArr(6, 1) = "Apprentice"
For i = 1 To 6
For j = 2 To UBound(tempArr, 2)
tempArr(i, j) = CDbl(0)
Next j
Next i
But surely there's a better way?

How can I "ReDim Preserve" a 2D Array in Excel 2007 VBA so that I can add rows, not columns, to the array?

I'm working with a dynamic array in Excel VBA. The number of columns (m) is fixed, however, I do not know how many rows (n) will be required.
The help documents state that ReDim Preserve myArray(n, m) allows me to make m larger, but not n. However, I need to increase the number of rows (n) while preserving my data, not columns (m)!
For example, I may have a (5,20) array that I would like to expand to (10,20) while preserving my data.
It seems that if there were some way to transpose my array, do a ReDim Preserve to expand the number of "columns", then re-transpose my array, I could accomplish what I want.
Is this the correct way to do this? If so, how can I do that?
Is there a better way to accomplish what I want?
One way to do what you want is to use a 1-D array that contains 1-D arrays instead of a 2-D array. Then you can ReDim Preserve the outer array all you want. If you're returning the outer array from a function, Excel will do the right thing and coerce it to a 2-D array.
For example, the function below will return a 3x2 array to the cells it's called from:
Public Function nested()
Dim outer
outer = Array(Array(1, 2), Array(3, 4))
ReDim Preserve outer(1 To 3)
outer(3) = Array(5, 6)
nested = outer
End Function
My answer to these questions might also be useful to you: Pass multidimensional array into Excel UDF in VBA and VBA pasting 3 dimensional array into sheet
Of course, if you're not returning this from a UDF, you'll have to coerce it yourself. An easy way to do that without writing looping code is to do this:
Dim coerced
coerced = Application.Index(outer, 0, 0)
This is just calling Excel's built-in INDEX function, and the zeros mean that you want back all of your rows and all of your columns. Excel will coerce your 1-D array of 1-D arrays to a 2-D array automatically. (Caveat: there are some size limitations, but they are much bigger than 10x20.)
One way how you could sove it is indeed by a double transpose with a change on the number of columns in between. This will however only work for two-dimensional arrays. It is done as follows:
' Adding one row is done by a double transposing and adding a column in between.
' (Excel VBA does not allow to change the size of the non-last dimension of a
' multidimensional array.)
myArray = Application.Transpose(myArray)
ReDim Preserve myArray(1 To m, 1 To n + 1)
myArray= Application.Transpose(myArray)
Of course m and n can be deduced as follows:
m = UBound(myArray, 1)
n = UBound(myArray, 2)
So you use the built-in transpose functionality of Excel itself. As mentioned in the code comments, this will not work for higher order matrices.
If you are developer - what is the difference between rows and columns?
Using array(N, 2) (if you have 2 columns) is the same as array(2, N) - for which you can
ReDim Preserve arr(1 to 2, 1 to N+1).
And the difference for you (as developer) will be to put the variable from the cycle in second place, instead of the first one:
N = ubound(arr)
FOR i=1 to N
GetColumn1Value = arr(1, i)
GetColumn2Value = arr(2, i)
NEXT i
Or you want this:
N = ubound(arr)
FOR i=1 to N
GetColumn1Value = arr(i, 1)
GetColumn2Value = arr(i, 2)
NEXT i
What is the difference?
Solved my own question; here's how I got around my problem. I created a temporary array, copied the contents of myArray to the temporary Array, resized myArray, then copied the contents back from the temp array to myArray.
tempArray = myArray
ReDim myArray(1 To (UBound(myArray()) * 2), 1 To m)
For i = 1 To n
For j = 1 To m
myArray(i, j) = tempArray(i, j)
Next j
Next i
If anyone can suggest a more efficient way to do this, I'd love to hear it.
The word 'transpose' immediately leaps to mind. You could simply enter data into the 2D array by flipping the columns and rows (i.e. transpose), effectively allowing you to make n (now the number of columns, but storing row values) larger when you require.
To reference the values, say in a double loop, swap the indices around. E.g. rather go from i = 1 to n and j = 1 to m where you reference value(i, j) , use i = 1 to m and j = 1 to n.
No way to determine the number of elements in the first dimension? Bummer. For a two-dimensional array with a fixed second dimension, you might want to consider making it an array of Types ("structs" in other languages) instead. That will allow you to use Redim Preserve, and still leaves you with a reasonable way to add and access values, though you'll now be accessing the second dimension as named members of the Type rather than is index values.
coercing or Slicing doesnt seem to work with Index( or Match(Index( when i want to filter array (w/o loops) based on multiple criteria, when the size of data spans greater than 2^16 rows (~ 92000 rows).
Run-Time error '13':
Type Mismatch
Transpose doesnt work with large recordsets and so also double Transpose does not work. isn't there anyway to filter an array and grab data without resorting to multiple loops?
I am thinking of trying the dictionary way or ADO with Excel.
A Caution on Redim Preserve
The urge to use ReDim Preserve here is likely misguided. Per Ken Getz and Mike Gilbert in the VBA Developer's Handbook (2006):
Using ReDim Preserve does preserve the contents of your array as it's
being resized, but it's not a fast operation... VBA must grab a chunk
of memory for the new array and then... copy over all the items in
your original array. Finally, it releases the memory used by the
original array. You'd do best to avoid ReDim Preserve if at all
possible.
Matthew Curland, a Microsoft VB developer, similarly noted in Advanced Visual Basic 6: Power Techniques for Everyday Programs (2000):
Suppose you anticipate needing 100 items up front, but... you
suddenly need space for number 101. The first reaction is a call to
ReDim Preserve to simply make the array larger. However, this call
gets more and more painful from a performance standpoint as the system
grows. You request more and more memory and possibly touch all the
memory you've previously filled. Even if you ReDim Preserve in chunks
instead of one element at a time, you'll find that the ReDim call is
the slowest part of the system.
In other words, ReDim Preserve is not as magical as it first appears. If you add one at a time, you'll see performance problems.
Now, copying an array by looping is slower yet. According to Curland, "VB's ReDim statement maps to the SafeArrayCreate[Ex] API, ReDim Preserve maps to SafeArrayRedim, and Erase maps to SafeArrayDestroy." Those APIs are much faster than loops. However, if you have to transpose the array to get there, it probably isn't worth it.
The direct way
For copying over by loop, the following sub will work. For limited use, it should be faster than transposing.
Sub RedimPreserveRows(source As Variant, newRowBound As Long)
'For 2d arrays, this copies the old data to a new array with a new Ubound for the first dimension (rows)
Dim rowBound As Long: rowBound = UBound(source)
Dim columnBound As Long: columnBound = UBound(source, 2)
Dim fillRowBound As Long: fillRowBound = IIf(newRowBound > rowBound, rowBound, newRowBound)
Dim returnArray()
ReDim returnArray(newRowBound, columnBound)
For i = 0 To fillRowBound
For j = 0 To columnBound
returnArray(i, j) = source(i, j)
Next
Next
source = returnArray
End Sub
For more: A question on alternatives to Redim Preserve was recently asked here, and I just reviewed some other options for resizing arrays in an answer here.
An array with 2 dimensions, where the number of columns are fixed and the number of rows are dynamic, can be created like this:
Sub test2DimArray()
Dim Arr2D() As String
Dim NumberOfCol As Long
Dim I As Long, J As Long, x As Long
Dim tmpValue As String, tmpValue2 As String, tmpValue3 As String
NumberOfCol = 3
J = 1
Debug.Print "Run " & Now()
Debug.Print "Sheet content"
Debug.Print "Row col1 col2 col3"
For I = 1 To 10
tmpValue = Cells(I, 1).Value
tmpValue2 = Cells(I, 2).Value
tmpValue3 = Cells(I, 3).Value
Debug.Print I & " = " & tmpValue & " " & tmpValue2 & " " & tmpValue3
If Len(tmpValue) > 0 Then
ReDim Preserve Arr2D(NumberOfCol, 1 To J)
Arr2D(1, J) = tmpValue
Arr2D(2, J) = tmpValue2
Arr2D(3, J) = tmpValue3
J = J + 1
End If
Next
'check array values
Debug.Print vbLf; "arr2d content"
Debug.Print "Row col1 col2 col3"
For x = LBound(Arr2D, 2) To UBound(Arr2D, 2)
Debug.Print x & " = " & Arr2D(1, x) & " " & Arr2D(2, x) & " " & Arr2D(3, x)
Next
Debug.Print "========================="
End Sub
TempValue read from cells A1:A10, if there is a value in cell Ax, it redim the array with +1, and add Tempvalue to array col1, add contents in Bx to array col2 and contents in Cx to array col3. If length of Ax-value is 0, it does not add anything to the array.
Debug.print show results in the "immediate window" in the VB editor.
Without the testing lines, and adding a dynamic data-range the code can be:
Sub my2DimArray()
Dim Arr2D() As String
Dim NumberOfCol As Long, NumberOfRow As Long
Dim FirstCol As Long, FirstRow As Long, LastCol As Long, LastRow As Long
Dim I As Long, J As Long, X As Long
Dim tmpValue As String, tmpValue2 As String, tmpValue3 As String
'if cells with values start in A1
With ActiveSheet.UsedRange
NumberOfCol = .Columns.Count
NumberOfRow = .Rows.Count
End With
'if cells with values starts elsewhere
With ActiveSheet.UsedRange
FirstCol = .Column
FirstRow = .Row
LastCol = .Column + .Columns.Count - 1
LastRow = .Row + .Rows.Count - 1
End With
J = 1
For I = 1 To NumberOfRow 'or For I = FirstRow to LastRow
tmpValue = Cells(I, 1).Value 'or tmpValue = Cells(I, FirstCol).Value
If Len(tmpValue) > 0 Then
ReDim Preserve Arr2D(NumberOfCol, 1 To J)
For X = 1 To NumberOfCol 'or For X = FirstCol to LastCol
Arr2D(X, J) = Cells(I, X).Value
Next X
J = J + 1
End If
Next I
End Sub

Resources