Create a dynamic 2-D array, if a value matches to a column

[Raghav Chamadiya]

Hi, so I am trying to create a dynamic VBA array, with 3 columns, and dynamic rows. This is my code so far:

Sub Test4()

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.AutomationSecurity = msoAutomationSecurityLow

Dim nwb As Workbook
Set nwb = Workbooks.Open("DB location")

Dim arr() As Variant
Dim strColumn As String
Dim strColumn2 As String

strColumn = "F"
strColumn2 = "C"
strColumn3 = "E"

Dim iVal As Integer
iVal = Application.WorksheetFunction.CountIf(nwb.Sheets("Data").Range("F2:F8"), "DS packaging")

ReDim arr(2, iVal)
With nwb.Sheets("Data")
lngLastRow = .Cells(.rows.Count, strColumn).End(xlUp).row
    For i = 0 To iVal - 1
    For lngRow = 2 To lngLastRow
            If .Cells(lngRow, strColumn).Value = "DS packaging" Then
                ReDim Preserve arr(2, i)
                arr(0, i) = .Cells(lngRow, strColumn).Value
                arr(1, i) = CDate(.Cells(lngRow, strColumn2).Value)
                arr(2, i) = CDate(.Cells(lngRow, strColumn3).Value)
            End If
    Next lngRow
    Next i
End With    
nwb.SaveAs Filename:="DB location"

MsgBox (arr(1, 1))
MsgBox (MatrixJoin(arr))

End Sub

And this is the database:

Ideally code should, search for DS packaging in the F column, and create an array, with 1st column as DS packaging, 2nd column as corresponding, Start Date, and 3rd column as corresponding End Date.

I know I have inverted rows and columns while defining array, and writing loop, thats because I read somewhere I can only preserve the last dimension in an array.
The current output from my code is:

The Matrix Join function simply, creates this matrix type view of the array:

Function MatrixJoin(M As Variant, Optional delim1 As String = vbTab, Optional delim2 As String = vbCrLf) As String
    Dim i As Long, j As Long
    Dim row As Variant, rows As Variant

    ReDim rows(LBound(M, 1) To UBound(M, 1))
    ReDim row(LBound(M, 2) To UBound(M, 2))

    For i = LBound(M, 1) To UBound(M, 1)
        For j = LBound(M, 2) To UBound(M, 2)
            row(j) = M(i, j)
        Next j
        rows(i) = Join(row, delim1)
    Next i
    MatrixJoin = Join(rows, delim2)
End Function

Please help. I am stuck on this from way too long.

 

[Peter_SSs]

First a couple of general suggestions:

• Investigate XL2BB for providing sample data to make it easier for helpers by not having to manually type out sample data to test with.
• You have shown the current output of your code which is not what you want but you have not shown the output that you do want.

Ideally code should, search for DS packaging in the F column, and create an array, with 1st column as DS packaging, 2nd column as corresponding, Start Date, and 3rd column as corresponding End Date.

So, I have not studied your code but attempted what I think you are saying here, starting from scratch. See if this is headed in the right direction.

Sub Make_Array()
  Dim aRws As Variant, arr As Variant

  With Range("C1", Range("F" & Rows.Count).End(xlUp))
    aRws = Filter(Application.Transpose(Evaluate(Replace("if(len(#),if(#=""DS packaging"",row(#),""x""),""x"")", "#", .Columns(4).Address))), "x", False)
    arr = Application.Index(.Cells.Value2, Application.Transpose(aRws), Array(4, 1, 3))
  End With
  With Range("J2").Resize(UBound(arr, 1), UBound(arr, 2))
    .Columns(2).Resize(, 2).NumberFormat = "d-mmm-yy"
    .Value = arr
  End With
End Sub

Here is my sample data and result of code:

Raghav Chamadiya.xlsm
	C	D	E	F	G	H	I	J	K	L
1
2	10-Jan-20		16-Jan-20	DS packaging				DS packaging	10-Jan-20	16-Jan-20
3	1-Jan-20		25-Jan-20	Other				DS packaging	29-Jun-20	28-Aug-20
4	5-Feb-20		4-Apr-20					DS packaging	19-Jun-20	7-Aug-20
5	29-Jun-20		28-Aug-20	DS packaging
6	19-Jun-20		7-Aug-20	DS packaging
7
Sheet1

 

[Raghav Chamadiya]

Thank you so much Peter, I will follow the points next time I post question here, thanks so much again.