[VBA] Array from another Array

[skorpionkz]

Hi guys,

I have 2 dimensional array created from the range. Now I need to keep data for specific code.

So I am looping an array and assigning the data from the row where code is match.
Problem is that I cannot ReDim new array to add new row.

Sample Data:

Excel 2010
	A	B	C
1	Code	Name	2 Nmae
2	1	AAA	A1
3	2	BBB	A2
4	3	CCC	A3
5	4	DDD	A4
6	5	EEE	A5
7	6	FFF	A6
8	5	GGG	A7
9	8	HHH	A8
10	9	JJJ	A9
11	10	KKK	A10
S

Code that not working:

Sub test2()
Dim wsS As Worksheet, wsR As Worksheet
Dim myArr() As Variant, myNewArr() As Variant
Dim i As Integer, j As Integer, y As Integer
Set wsS = Sheets("S")
Set wsR = Sheets("R")
myArr = wsS.Range("A2:C11")
y = 0
For i = 1 To UBound(myArr, 1)
        If myArr(i, 1) = "5" Then
        y = y + 1
        ReDim Preserve myNewArr(1 To y, 1 To UBound(myArr, 2))
            For j = 1 To UBound(myArr, 2)
                myNewArr(y, j) = myArr(i, j)
            Next j
        End If
Next i
wsR.Range("A2").Resize(UBound(myNewArr, 1), UBound(myNewArr, 2)) = myNewArr

End Sub

I was trying to find work around and it works, but this required 2 loops (don't realy like it):

Sub test()
Dim wsS As Worksheet, wsR As Worksheet
Dim myArr() As Variant, myNewArr() As Variant
Dim i As Integer, j As Integer, y As Integer
Set wsS = Sheets("S")
Set wsR = Sheets("R")
myArr = wsS.Range("A2:C11")
y = 0
For i = 1 To UBound(myArr, 1)
        If myArr(i, 1) = "5" Then
        y = y + 1
        End If
Next i
ReDim Preserve myNewArr(1 To y, 1 To UBound(myArr, 2))
y = 0
For i = 1 To UBound(myArr, 1)
        If myArr(i, 1) = "5" Then
        y = y + 1
            For j = 1 To UBound(myArr, 2)
                myNewArr(y, j) = myArr(i, j)
            Next j
        End If
Next i
wsR.Range("A2").Resize(UBound(myNewArr, 1), UBound(myNewArr, 2)) = myNewArr
End Sub

is there is a way to make first macro work? I am open for any other better solution for this task!

Tank you,
Andrew

 

[MickG]

Perhaps this:-

[COLOR="Navy"]Sub[/COLOR] MG25May55
[COLOR="Navy"]Dim[/COLOR] wsS [COLOR="Navy"]As[/COLOR] Worksheet, wsR [COLOR="Navy"]As[/COLOR] Worksheet
[COLOR="Navy"]Dim[/COLOR] myArr() [COLOR="Navy"]As[/COLOR] Variant, myNewArr() [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] i [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] j [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] y [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Set[/COLOR] wsS = Sheets("S")
[COLOR="Navy"]Set[/COLOR] wsR = Sheets("R")
myArr = wsS.Range("A2:C11")
y = 0
[COLOR="Navy"]For[/COLOR] i = 1 To UBound(myArr, 1)
        [COLOR="Navy"]If[/COLOR] myArr(i, 1) = "5" [COLOR="Navy"]Then[/COLOR]
        y = y + 1
        '[COLOR="Green"][B]You can only Redim the last element of the array,[/B][/COLOR]
        '[COLOR="Green"][B]so you need to transpose it by building the columns in the Rows and the Rows in the columns, As below!![/B][/COLOR]
        '[COLOR="Green"][B]Array below Rows and Columns Swapped[/B][/COLOR]
        ReDim Preserve myNewArr(1 To UBound(myArr, 2), 1 To y)
            [COLOR="Navy"]For[/COLOR] j = 1 To UBound(myArr, 2)
                '[COLOR="Green"][B]Altered Here, =swap J for Y, and Y for J[/B][/COLOR]
                myNewArr(j, y) = myArr(i, j)
            [COLOR="Navy"]Next[/COLOR] j
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] i
        '[COLOR="Green"][B]Altered Here,for rows and columns count,          'Altered Here, by Transposing the Array)[/B][/COLOR]
wsR.Range("A2").Resize(y, UBound(myNewArr, 1)) = Application.Transpose(myNewArr)


[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[skorpionkz]

Thank you

'You can only Redim the last element of the array,

This is where i had gap in the knowladge.

 

[MickG]

You're welcome