Input Range in 1D array - excel

I am doing some code to put a range into an array so i can create plots by analyzing the data inside that array. I am trying to use a general code for the range since the input can be different depending on the type of analysis i want to perform. Tried to find a solution for this in other questions without success.
Dim DieBankArray As Variant
last_row = Sheets("Tabela CT geral").Range("A2").End(xlDown).Row 'Last row of the data set
For i = 0 To last_row - 2 '-2 to exclude the first line and another value because the array first position is 0, not 1
DieBankArray(i) = Range("A" & i + 2)
Next
The return is a type mismatch error that i can't understand...

Here's one approach:
Function RangeTo1DArray(rngStart As Range)
Dim rv(), arr, r As Long, n As Long
'read the source data to an array for better performance
With rngStart.Parent
arr = .Range(rngStart, .Cells(Rows.Count, rngStart.Column).End(xlUp)).Value
End With
n = UBound(arr, 1)
ReDim rv(0 To n - 1)
'Fill the output array. Note: purposefully not using transpose()
' to avoid its limitations
For r = 1 To n
rv(r - 1) = arr(r, 1)
Next r
RangeTo1DArray= rv
End Function

Ok, i used the Redim and it worked just fine.
What i couldn't understand is that there's a need to set the correct size of an array to read/write data. I thought a simple Dim as Variant should be enough to store the data at my will without need to set a correct size each time i want to use an array.
The code after ReDim:
Dim DieBankArray As Variant
last_row = Sheets("Tabela CT geral").Range("A2").End(xlDown).Row 'Last row of the data set
ReDim DieBankArray(A2 To last_row - 2)
For i = 0 To last_row - 2 '-2 to exclude the first line and another value because the array first position is 0, not 1
DieBankArray(i) = Range("A" & i + 2)
Next

Related

How to resize one dimensional array VBA using Redim

I am trying to resize a dynamic array (Sub rangearray) with new values after checking if any values in the original array > 590.
The array is one dimensional column with a range of figures as shown below just 1 column and multiples rows.
I have tried a variety of possible solutions and none seems to work. I can observe on the Locals window even though this is a one dimensional array it appears a two dimensional with (1 to 5, 1 to 1) and I did manage to obtain 620 and 630 on the message box and I tried to replicate this code for the worksheet but I constantly got subscript out of range.
I would appreciate if someone could please let me know what I need to do to resize the array (copied to sheet) with only the new values not the previous values and also explain the dimension of one dimension and multiples dimensions array.
I do know that with Redim you can only change the second dimension and that is where I am a bit confused does the one dimension below have two dimension or one its seems like two otherwise it would only have one dimension which should make resizing easier.
Solution that works but just message box not worksheet
For i = 1 To 5
For j = 1 To 1
If arr(i, j) > 590 Then
MsgBox arr(i, j)
End If
Next j
Next i
Dataset
590
590
590
620
630
Array that does not work below paste value from resized array to worksheet
Sub rangearray()
Dim arr() As Variant
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim i As Variant
Dim ws2 As Workbook
Set ws2 = Workbooks("PRA.XLSM")
Set ws = Workbooks("PRA.XLSM").Worksheets("Rec")
Set ws1 = Workbooks("PRA.XLSM").Worksheets("CPT")
arr() = ws.Range("a4:a15").Value
For Each i In arr
If i > 590 Then
ReDim arr(i)
arr(i) = i
End If
Next i
ws1.Range("A4:A15").Value = WorksheetFunction.Transpose(arr)
End Sub
Your array to be processed is a 2D array type. You do not need (only) an 1D array to accomplish what you want, but if this is your wish, it can be done using another array (1D in this case, but it could be 2D, too).
Redim can be used for any Dim array without specifying the dimensions. Redim Preserve can be used only for the second dimension and it means changing the second one, but preserving values.
Please, use this code to accomplish what (I understood) you wanted:
Dim arr() As Variant, ws As Worksheet, ws1 As Worksheet, i As Long
Dim arrF As Variant, k As Long
Set ws = Workbooks("PRA.XLSM").Worksheets("Rec")
Set ws1 = Workbooks("PRA.XLSM").Worksheets("CPT")
arr() = ws.Range("a4:a15").Value
ReDim arrF(UBound(arr))
For i = 1 To UBound(arr)
If arr(i, 1) < 590 Then
arrF(k) = arr(i, 1): k = k + 1
End If
Next i
ReDim Preserve arrF(k - 1)
ws1.Range("A4").Resize(UBound(arrF) + 1, 1).Value = WorksheetFunction.Transpose(arrF)
End Sub
What I think it is good to know, you could also use a 2D (new) array. In such a case you had to Redim in this way:
ReDim arrF(1 To 1, 1 To UBound(arr))' the rows and columns are reversed, only to allow Redim Preserve (for the last dimension), after the loop where it was load
It should be load (like a 2D array) in this way:
arrF(1, k) = arr(i, 1)
And Resize should be adapted to a 2D array:
ws1.Range("A4").Resize(UBound(arrF, 2), 1).Value
Transpose is maintained but only to transpose rows to columns...
Declare a new variable named value (1-dimensional array), after check condition, use redim preserve combination with worksheetfunction.transpose will work:
Here's sample code:
Sub rangearray()
Dim value()
ReDim value(1 To 15 - 4 + 1)
arr = Range("a4:a15").value
Dim i As Integer
i = 1
For Each cell In arr
If cell > 590 Then
value(i) = cell
i = i + 1
End If
Next
ReDim Preserve value(1 To i - 1)
Range("A4:A15").Clear 'clear contents before write new values
Range("A4:A15").Resize(i - 1, 1).value = WorksheetFunction.Transpose(value)
End Sub
Try,
Sub rangearray()
Dim arr() As Variant
Dim a() As Variant
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim i As Long
Dim ws2 As Workbook
Dim n As Long
Set ws2 = Workbooks("PRA.XLSM")
Set ws = Workbooks("PRA.XLSM").Worksheets("Rec")
Set ws1 = Workbooks("PRA.XLSM").Worksheets("CPT")
arr() = ws.Range("a4:a15").Value
For i = 1 To UBound(arr, 1)
If arr(i, 1) > 590 Then
n = n + 1
ReDim Preserve a(1 To n)
a(n) = i
'a(n) = i + 3 'If you need the cell's row number,
End If
Next i
ws1.Range("A4").Resize(n) = WorksheetFunction.Transpose(a)
End Sub
First of all when you copy the values of a a range (multi-cell) into a Variant, you will always get a two-dimensional array. For example
Dim arr As Variant
arr = Range("A1:A5")
means that arr is a two dimensional array similar to arr(1 to 5, 1 to 1) (i.e. 5 rows and 1 column)
If you want to get a one-dimensional array you can use the Transpose worksheet function
Dim arr as Variant
arr = WorksheetFunction.Transpose(Range("A1:A5"))
Now it is like arr(1 to 5)
I am confused as to what you're doing in the loop. For example when you find a value of i > 590 (e.g. 600) you are re-dimensioning the array to 600 elements. Is that what you want? Furthermore, you are not perserving any values. For each i in arr gives i values of the elements of your arry (not the index), so doing something like arr(i) = i is assining the value of i to the ith element (is this what you're trying to achieve?)
I get the impression, all you want is to change values of those elements > 590 and for that you do not need to Redim: You simply change the value.
If you can explain exactly what you're trying to achieve, then I (or someone else) can help you further.
Edit (Answer):
Here are two of many ways you can achieve what you want:
The simplest way is to use the Filter() worksheet function. In your destination range enter the array formula
=FILTER(Rec!$A$4:$A$15,Rec!$A$4:$A$15>590)
Build an array to store the filtered values (I guess this is the approach you prefer)
Sub rangearray()
Dim vInput As Variant
Dim arrOutput() As Variant
Dim v As Variant
Dim lOutElems As Long: lOutElems = 0
Dim wb As Workbook: Set wb = ThisWorkbook ' Workbooks("PRA.XLSM")
Dim ws As Worksheet: Set ws = wb.Worksheets("Rec")
Dim ws1 As Worksheet: Set ws1 = wb.Worksheets("CPT")
vInput = ws.Range(ws.Range("A4"), ws.Range("A" & Rows.count).End(xlUp)).Value
'vInput = ws.Range("a4:a15").Value ' or hardcoded
For Each v In vInput
If v > 590 Then
lOutElems = lOutElems + 1
ReDim Preserve arrOutput(1 To lOutElems)
arrOutput(lOutElems) = v
End If
Next v
ws1.Range("A4").Resize(lOutElems, 1).Value = WorksheetFunction.Transpose(arrOutput)
End Sub
Another approach is to use autofilter (in excel sheet or in VBA). You could also use the Filter() worksheet function in VBA. The choice is yours.
You can read single column values into a 1D array using WorksheetFunction.Transpose twice. For example, you have a column with data starting in A1 cell. Then you can fill the 1D array as follows:
Sub ch()
Dim arr()
Dim nRows As Integer
nRows = Sheet1.Range("A1").End(xlDown).Row
ReDim arr(1 To nRows)
arr = WorksheetFunction.Transpose(WorksheetFunction.Transpose(Sheet1.Range("A1").Resize(nRows, 1)))
End Sub

How to store ranges in array, collection, or dictionary based on criteria?

I am attempting to parse through a contiguous range of data (orng) and create subranges from orng that contain the same string value in the 6th column of orng. Each subrange has 1-15 rows and 38 columns. As far as I know, I can't create a new range object for each subrange since the number of subranges is unknown. I've created an array that contains the data for the subranges (aData). I have gotten it to work with the code below, but I feel like there is a much cleaner way of doing it that I can't figure out. I've also tried using a dictionary with no success. I will eventually have to call upon all the data for calculations and using multiple nested for loops to access each element seems convoluted.
I am using Excel Professional Plus 2016 (not sure if that matters).
Using an array is the only way I could manage to get the end result I'm looking for, which is fine. I would prefer that the array was dynamic, but whenever I attempted the ReDim Preserve method the values would not be saved to the array. The size of the array would be perfect, but every element was "Empty". According to Microsoft "each element of an array must have its value assigned individually" so I guess I can't assign range values to an array in chunks. After I found that webpage I implemented an array with a predetermined structure and the nested for loops.
Ideally, I could separate orng into different Areas, but since it is contiguous I am unable to do so. What I'd like to know is 1) is there a better way to do what I am trying to do? (Easier to read, faster, less code, etc. and 2) if there is not a better way, can I get some advice on how to make this code cleaner (dynamic range, less loops, better structure)?
Private Sub rangetest()
Dim twb As Workbook: Set twb = ThisWorkbook
Dim cws As Worksheet: Set cws = twb.Sheets("Cleaned_2019+")
Dim orng As Range
Dim datelot As String, datelotcomp As String
Dim c As Long, i As Long, j As Long, k As Long, numrows As Long, lastrow
As Long, numlots As Long, _
curRow As Long, lotRows As Long, startRow As Long, layerRows As Long,
aRow As Long
Dim aLot() As Variant, aData(9, 49, 37) As Variant
Dim Z As Boolean
Set orng = cws.Range("A973:AL1014") 'Set initial range to work with.
numrows = orng.Rows.Count 'Number of rows in orng.
curRow = 1 'Current row in orng.
startRow = 1 'Starting row in orng for next
layer (changes when lot changes).
i = 0 'Layer of array (for aLot and aData arrays).
j = 0 'Row in orng where values for previous layer ended.
Z = False
Do Until Z = True
datelot = Left(orng.Cells(curRow, 6).Value, 10) 'Lot that we want the data for. Corresponds to a layer in the aData array.
datelotcomp = Left(orng.Cells(curRow + 1, 6).Value, 10) 'Lot of the next row in data sheet.
If datelot <> datelotcomp Then 'If datelotcomp <> to datelot then we want a new layer for array.
layerRows = curRow - j 'Number of rows for a particular layer
ReDim Preserve aLot(i) 'Array of lot names
aLot(i) = datelot 'Assign lot name to aLot array
For aRow = 1 To layerRows 'Row index in array
For lotRows = startRow To curRow 'Loops through orng rows and sets those values in array
For c = 1 To 38 'Loops through columns. There are always 38 columns
aData(i, aRow - 1, c - 1) = orng.Cells(lotRows, c).Value 'Add values to each index in array
Next c
Next lotRows
Next aRow
j = curRow
i = i + 1
startRow = curRow + 1
End If
If curRow = numrows Then 'End loop at end of orng
Z = True
End If
curRow = curRow + 1
Loop
numlots = i
End Sub
The result I get is an array with the structure aData(9, 49, 37) that contains data in the first 4 layers aData(1-3, , ). This corresponds with the number of lots that are in orng so the code is working correctly. I'd just like advice on if I'm doing anything inefficiently.
I will be checking back to answer questions or to add clarification.
Edit 1:
The question ended up being answered here (Code Review) for those interested.

Copy single row range to array then pass ByRef to function VBA

I've been struggling with this code here (probably very simple mistake), would anyone mind pointing out where my issues are? My overall goal is to allow this subroutine to accept a range of variable size, however I can't seem to get it to work for a fixed size.
If I manually allocate the array, things work as expected but when I allocate with a range that's where things go wrong. The output comes back untouched, which leads me to believe that I'm not doing something correctly with the allocation. Also I'm getting errors when I try to pass ws.UsedRange as oppose to a fixed range.
Private Sub InsertionSort(ByRef a(), ByVal lo0 As Long, ByVal hi0 As Long)
Dim i As Long, j As Long, v As Long
For i = lo0 + 1 To hi0
v = a(i)
j = i
Do While j > lo0
If Not a(j - 1) > v Then Exit Do
a(j) = a(j - 1)
j = j - 1
Loop
a(j) = v
Next i
End Sub
Sub runSort()
Dim ws As Worksheet
Set ws = ActiveWorkbook.ActiveSheet
Dim myArr() As Variant
Dim rangeUse As Range
With ws.Range("D17:K17")
ReDim myArr(1 To 1, 1 To ws.Range("D17:K17").Columns.Count)
myArr = ws.Range("D17:K17").Value
End With
Call InsertionSort(myArr, LBound(myArr), UBound(myArr))
Range("D19:K19") = myArr
End Sub
Any help would be appreciated! TIA
So considerating you only want to sort your 2-dimensional array row by row, this might be a useful starting point. You can always change With ws.Range("A2:A3") to With Selection. If you do so, you have the Range you selected with your cursor.
With ws.Range("A2:A3")
myArr = .Value
For i = 1 To .Rows.Count
ReDim tmpArr(1 To .Columns.Count)
For j = 1 To .Columns.Count
tmpArr(j) = myArr(i, j)
Next j
Call InsertionSort(tmpArr, 1, .Columns.Count)
For j = 1 To .Columns.Count
myArr(i, j) = tmpArr(j)
Next j
Next i
.Offset(RowOffset:=10) = myArr
End With
Detailed Description
You don't have to redim myArray because if you set it to a range, it automatically scales.
tmpArr is each row of your range. If you select your range with the cursor some rows might be shorter or longer than others, thats why we redim that one. Edit This doesn't work just yet, because .Columns.Count refers to the whole range, not just the row. If you have different column counts then you'd have to change that.
For j = 1 To .Columns.Count
tmpArr(j) = myArr(i, j)
Next j
Unfortunately we cannot use tmpArr = myArr(i) because only one dimension of a multidimensional array cannot be accessed like this in VBA.
Call InsertionSort(tmpArr, 1, .Columns.Count) calles your Insertion Sort algorithm and sorts one row at a time.
After tmpArray got sorted, we have to set myArray(i) to the new values with the same loop we already used:
For j = 1 To .Columns.Count
myArr(i, j) = tmpArr(j)
Next j
Now we sorted all the rows in our Range, now we can put it back on the sheet, 10 rows beneath the first row of the specified range with .Offset(RowOffset:=10) = myArr
I hope that this helps you! While testing I saw that you might have a little bug in your InsertionSort algorithm. If the first value is the smalles, it just blindly gets copied into all the other fields of the array :)

empty cells returned by an array

I have been working on this particular problem for sometime and am obviously missing something very simple. I ma trying to create an aray based on a dynamic range in Excel and using the individual elements to compare against another array. The only problem with the attached code is it continues to show empty elements. Any guidance would be appreciated.
Part of my overall code attached.
Sub Test_Again()
Dim R As Long
Dim C As Long
Dim List() As Variant
Dim i As Integer
List = Sheets("Sheet11").Range("A2:A17").Value
For R = 1 To UBound(List, 1) ' First array dimension is rows.
For C = 1 To UBound(List, 2) ' Second array dimension is columns.
Debug.Print List(R, C)
Next C
Next R
ReDim List(UBound(List, 1))
Do Until i = UBound(List)
If List(i) = Now() Then
End If
i = i + 1
Loop
End Sub
The normal Redim will clear your array - unless you use Redim Preserve. However, according to the help:
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. For example, if your array has only one dimension, you can resize that dimension because it is the last and only dimension. However, if your array has two or more dimensions, you can change the size of only the last dimension and still preserve the contents of the array.
Therefore, in your case Redim will not help you here. If you want to transfer a two dimensional array to a one dimensional array, you need to do this manually instead:
Sub Test_New()
Dim lRow As Long, lCol As Long
Dim vListSource() As Variant, vListTarget() As Variant
'Assign soure array
vListSource = Sheets("Sheet11").Range("A2:A17").Value
'Show full content for debug
For lRow = LBound(vListSource) To UBound(vListSource) ' First array dimension is rows.
For lCol = LBound(vListSource, 2) To LBound(vListSource, 2) ' Second array dimension is columns.
Debug.Print vListSource(lRow, lCol)
Next lCol
Next lRow
'Transfer array to one dimension
ReDim vListTarget(LBound(vListSource) To UBound(vListSource))
For lRow = LBound(vListSource) To UBound(vListSource)
vListTarget(lRow) = vListSource(lRow, LBound(vListSource, 2))
Next lRow
'Your check code
For lRow = LBound(vListTarget) To UBound(vListTarget)
If vListTarget(lRow) = Now() Then
'Do something here
End If
Next lRow
End Sub
This will copy the first row of your range/array to a one dimensional array and use this for further processing.
However, from your code and question I do not see the advantage of redimming it to one dimension - you could easily do your loop one the two dimensional array - and just look in the first and only column.

Multidimensional array storing/printing issues

I'm working on a parser for use at work. Basically I have an excel document full of rows of data that I need to parse through and store into a multidimensional array to work with.
Here is the code I have so far:
Dim a
Dim iRows As Long
Dim i As Integer
Dim aArray() As Variant
a = Array(2,3,4,5,6,9,10,14,19,21,23,25,29,38)
iRows = ActiveWorkbook.Sheets(1).UsedRange.Rows.Count
ReDim aArray(iRows, UBound(a))
For i = 2 To iRows + 1
For x = 0 To UBound(a)
aArray(i - 2, x) = ActiveSheet.Cells(i, a(i - 2)).Value
Next x
Next i
Keep in mind the offset of i = 2 and iRows + 1 is to ignore the header row
The problem is that when I attempt to output it I am finding that all the rows are the same so aArray(0,1) and aArray(1,1) are the same values which they should be different values from different rows of the excel file.
furthermore there should be 14 columns that I am storing per row but when i try to output any value past location 9 i get an out of range error like so
ActiveSheet.Cells(1, 1).Value = aArray(10, 0)
ActiveSheet.Cells(1, 2).Value = aArray(11, 0)
Based on the small array I am using to specify which values to store in the main array their should be 14 total locations for each sub array contain within aArray.
Any insights?
Keep in mind that this is my first real VBA script so if I am making mistakes please have patients with my I m coming from a JS/PHP background so this is a lot different for me.
You switched the dimensions in aArray. In the code you redim and fill aArray with (count_of_rows_in_usedRang,count_of_elements_in_a) and I imagine used rang is just 9 lines, so aArray(10, 0) is out of range while aArray(0,10) wouldn't be.
I think there may be a similar problem with the output in the first part of your question. If not: please post, what is in the excel-sheet and what you got as a result.
If you are looking to simply read data from a worksheet, ignoring the headings, you're over complicating it. Something like this will work:
Const intOffsetRow As Integer = 2
Dim rngUsedRange As Range
Dim varWksArray As Variant
Set rngUsedRange = ActiveWorkbook.Sheets(1).UsedRange
With rngUsedRange
varWksArray = .Range(Cells(intOffsetRow, 1), Cells(.Rows.Count, .Columns.Count)).Value
End With
Set rngUsedRange = Nothing
If you don't mind there being a blank / empty row / dimension in your array, it can be simplified even further:
Const intOffsetRow As Integer = 1
Dim rngUsedRange As Range
Dim varWksArray As Variant
Set rngUsedRange = ActiveWorkbook.Sheets(1).UsedRange
varWksArray = rngUsedRange.Offset(intOffsetRow, 0).Value
Set rngUsedRange = Nothing

Resources