get data at runtime - excel

Question

I have to capture sheet row into a 2d array. I am using the following code
Code :
Sub multiarr()
Dim str As String 'String Which i am looking for
Dim result() As String 'Stores Splitted Substring
Dim r As Integer ' Row Counter of 2d array
Dim c As Integer ' Column Counter of 2d Array
Dim valarr() As String ' Initial Declaration of Array
'Row and Column Initialization
r = 0
c = 0
'Calculate Last Row and Last Column of Sheet
mylr = Cells(Rows.Count, 1).End(xlUp).Row
lcol = Cells(1, Columns.Count).End(xlToLeft).Column
'Initialize the Array according to Sheet Dimentions
ReDim valarr(mylr - 2, lcol - 1) 'Declare Array to be of size of Sheet
str = "M1" ' -> This i am interested in.Only these records will be populated
For y = 0 To UBound(valarr) 'iterate through rows of array
For x = 2 To mylr 'iterate through rows of sheet
result = Split(Cells(x, 1), "#") ' Split the Record
If result(0) = str Then 'Check for the Condition
'Array Filling Logic
For c = 1 To lcol
' C-1 because column index starts from 0
valarr(y, c - 1) = Cells(x, c)
Next c
End If
Next x
Next y
End Sub
But this code is incorrectly filling. What is the problem?
Please refer sample image of worksheet
Thanks in advance

Answer 1

Please see the bellow, hope it helps
Sub multiarr()
Dim str As String 'String Which i am looking for
Dim result() As String 'Stores Splitted Substring
Dim r As Integer ' Row Counter of 2d array
Dim c As Integer ' Column Counter of 2d Array
Dim valarr() As String ' Initial Declaration of Array
Dim mylr As Long, lcol As Long 'lastrow / lastcol
'I recommend declaring the workbook/worksheet and declaring the ranges accordingly
'Without doing so, any range refence bellow is explicit to the ActiveSheet
Dim arrValues As Variant
Dim cnt As Long, cnt2 As Long
'Row and Column Initialization
r = 1
c = 1
'Calculate Last Row and Last Column of Sheet
mylr = Cells(Rows.Count, 1).End(xlUp).row
lcol = Cells(1, Columns.Count).End(xlToLeft).column
arrValues = Range(Cells(r, c), Cells(mylr, lcol))
str = "M1" ' -> This i am interested in.Only these records will be populated
For y = LBound(arrValues) To UBound(arrValues) 'Iterate through values
If Left(arrValues(y, 1), 2) = str Then 'Check if the correct value exists
cnt = cnt + 1 'Count the number of occurences
End If
Next y
'Initialize the Array according to Results Dimentions
ReDim valarr(1 To cnt, 1 To lcol) 'Declare Array to be of size of Sheet
cnt2 = 1 'Start at one to match the array of the values, but... feel free to change
For y = LBound(arrValues) To UBound(arrValues) 'Iterate through array rows
If Left(arrValues(y, 1), 2) = str Then 'Check if the correct value exists
For z = LBound(arrValues, 2) To UBound(arrValues, 2) 'Iterate through array columns
valarr(cnt2, z) = arrValues(y, z) 'Add to the arr only correct values
Next z
cnt2 = cnt2 + 1 'If value find, we increase the counter
End If
Next y
End Sub

Answer 2

this answer only addresses the issue of getting a range into a 2-D array, not the processing of the elements.
This code is a pretty efficient method:
Sub multiarr()
Dim str As String 'String Which i am looking for
Dim result() As String 'Stores Splitted Substring
Dim r As Integer ' Row Counter of 2d array
Dim c As Integer ' Column Counter of 2d Array
Dim valarr()
valarr = Range("A1").CurrentRegion
MsgBox LBound(valarr, 1) & "-" & UBound(valarr, 1) & vbCrLf & LBound(valarr, 2) & "-" & UBound(valarr, 2)
End Sub
If you can't adapt the approach to your needs, ignore this answer.

Answer 3

Use auto filter (see comments in code):
Sub multiarr()
Dim rng As Range, rngData As Range, rngFilter As Range
'// Full range
Set rng = Range("A1").CurrentRegion
'// Range without a header
With rng
Set rngData = .Offset(1).Resize(.Rows.Count - 1)
End With
rng.AutoFilter Field:=1, Criteria1:="M1*"
'// Error handling in case if no rows will be filtered
On Error Resume Next
Set rngFilter = rngData.SpecialCells(xlCellTypeVisible)
If Err = 0 Then
'// Do something with your range.
'// Do not forget to use Areas,
'// since rngFilter can be non-contiguous:
'// Dim cell As Range, rngRow As Range, rngArea As Range
'// For Each rngArea in rngFilter.Areas
'// For Each cell in rngArea
'// 'Or For Each rngRow in rngArea.Rows
'// // Do something...
'// Next
'// Next
End If
On Error GoTo 0
End Sub