skorpionkz
Wellknown Member
 Joined
 Oct 1, 2013
 Messages
 1,171
 Office Version

 2016
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:
Code that not working:
I was trying to find work around and it works, but this required 2 loops (don't realy like it):
is there is a way to make first macro work? I am open for any other better solution for this task!
Tank you,
Andrew
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:
Code:
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):
Code:
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