PDA

View Full Version : [SOLVED:] Array Index new with Criteria of Old Array



xman2000
04-01-2017, 01:34 PM
Hi, People!

Array Index new WITH Criteria of Old Array
edit: wrong title of thread, read With instead wiht

RANGE("A1:A10")
I want get the individual Rows of values of array StudentMarks after find this values,
usind like this "rng(1).address"

I want get the indiviual elements (.row) of Resultant Arrary of other Array after compares with criteria in the Loop "For each Cel".

New Array index corresponds to number of elements and get only elmentes with matche the criteria (value=34).

I Want get the Individual Elements (.row) of criteria (.value = 34) , results New Aray of 4rows (row 2, row 3, row 7, row 9) 4 elements.

New Array starts with 1 (1 to 4)

I want accessing the red values of new array with like pseudocode
ArrayNew(1,1) = rng(1) "row2
ArrayNew(1,2) = rng(2) "row3
ArrayNew(1,3) = rng(3) "row7
ArrayNew(1,4) = rng(4) "row9



look the Sample File atached.
thank you.
18819




''==============================================================
Sub ArrayNewOfOldArray1()
''https://excelmacromastery.com/excel-vba-array/
Dim c As Variant
Dim StudentMarks As Variant
dim Rng as Range
set Rng = Range("A1:a10")
18819
For Each c In Rng.cells
If c.Value = 34 Then StudentMarks = c.Address

If c.Value = 34 Then MsgBox "MSBOX1 " & StudentMarks
Next c

MsgBox "MSBOX2 " & StudentMarks
Dim i As Long

'For i = LBound(StudentMarks) To UBound(StudentMarks)
'Next i
'Dim resulado As Variant
'RESULTADO = StudentMarks(2, 1)
'MsgBox RESULTADO




End Sub


I want accessing the red values of new array with like pseudocode
ArrayNew(1,1) = rng(1) "row2
ArrayNew(1,2) = rng(2) "row3
ArrayNew(1,3) = rng(3) "row7
ArrayNew(1,4) = rng(4) "row9


18820

mana
04-01-2017, 05:27 PM
Option Explicit


Sub test()
Dim Rng As Range, c As Range
Dim StudentMarks()
Dim n As Long


Set Rng = Range("A1:a10")
ReDim StudentMarks(1 To Rng.Count)

For Each c In Rng
If c.Value = 34 Then
n = n + 1
StudentMarks(n) = c.Address
End If
Next c

If n > 0 Then
ReDim Preserve StudentMarks(1 To n)
MsgBox Join(StudentMarks, vbLf)
End If

End Sub

xman2000
04-01-2017, 06:01 PM
Hi, Mana !
great help, thank you, works perfect !

but i need understand some things, try some things.
is possible other approach to this Excerpt ???



If n > 0 Then
ReDim Preserve StudentMarks(1 To n)
MsgBox "msgbox7 All Itens Join" & Join(StudentMarks, vbLf)
End If


My goal i make wih your help.



MsgBox "msgbox3 " & StudentMarks(1) ''returns $A:$2
MsgBox "msgbox4 " & StudentMarks(2) ''returns $A:$3
MsgBox "msgbox5 " & StudentMarks(3) ''returns $A:$7
MsgBox "msgbox6 " & StudentMarks(4) ''returns $A:$9




Working code perfect.



Option Explicit
Sub test_Mana_perfeito1()
Dim Rng As Range, c As Range
Dim StudentMarks()
Dim n As Long


Set Rng = Range("A1:a10")
ReDim StudentMarks(1 To Rng.count)

For Each c In Rng
If c.Value = 34 Then
n = n + 1
StudentMarks(n) = c.Address
MsgBox "msgbox1 All Itens Indivivual " & StudentMarks(n)
End If
Next c

MsgBox "msgbox2 Last Item " & StudentMarks(n)
MsgBox "msgbox3 " & StudentMarks(1) ''returns $A:$2
MsgBox "msgbox4 " & StudentMarks(2) ''returns $A:$3
MsgBox "msgbox5 " & StudentMarks(3) ''returns $A:$7
MsgBox "msgbox6 " & StudentMarks(4) ''returns $A:$9

If n > 0 Then
ReDim Preserve StudentMarks(1 To n)
MsgBox "msgbox7 All Itens Join" & Join(StudentMarks, vbLf)
End If

End Sub