How to resize one dimensional array VBA using Redim - excel

Question

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

Answer 1

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...

Answer 2

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

Answer 3

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

Answer 4

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.

Answer 5

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