Populate an array one value at a time - arrays

Question

I want to run through each cell in a column and if a condition is met place it into the next available array element.
I have the first part but I don't know how to place each element that meets the IF statement criteria into an array and then transpose that array.
Option Explicit
Private Sub Workbook_Open()
Dim StepCheck As Range
Dim ImporterName As Variant
Dim ws As Worksheet
Dim NameRange As Range
Set ws = Workbooks.Open(Filename:="Filepath goes here").Sheets("Sheet1")
For Each StepCheck In ws.Range("F1:F" & ws.Cells(ws.Rows.Count, "F").End(xlUp).Row)
If IsError(StepCheck.Value) Then
If Err.Number <> 0 Then
Err.Clear
On Error GoTo 0
End If
ElseIf StepCheck.Value = "5" Then
ImporterName = StepCheck.Offset(0, -5).Value
End If
Next
End Sub
How do I store every StepCheck when it meets the IF statement criteria into the array importer name?
The code runs but doesn't store all of the StepCheck entries into the array and instead gets overwritten every loop.

Answer 1

Match Data
It will return the values from column A from the rows where the value in column F is equal to 5 in a 1D array and print its contents in the Immediate window.
Option Explicit
Sub MatchData()
' (Open and) Reference the workbook ('wb').
Dim wb As Workbook: Set wb = Workbooks.Open("C:\Test\Test.xlsx")
' For the workbook containing this code, use:
'Dim wb As Workbook: Set wb = ThisWorkbook
' Reference the worksheet ('sws').
Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet1")
' Write the values from the source lookup column
' to a 2D one-based one-column array ('slData').
Dim slrg As Range
Set slrg = sws.Range("F1", sws.Cells(sws.Rows.Count, "F").End(xlUp))
Dim srCount As Long: srCount = slrg.Rows.Count
Dim slData() As Variant
If srCount = 1 Then
ReDim slData(1 To 1, 1 To 1): slData(1, 1) = slrg.Value
Else
slData = slrg.Value
End If
' Write the values from the source value column
' to a 2D one-based one-column array ('svData').
Dim svrg As Range: Set svrg = slrg.EntireRow.Columns("A")
Dim svData() As Variant
If srCount = 1 Then
ReDim svData(1 To 1, 1 To 1): svData(1, 1) = svrg.Value
Else
svData = svrg.Value
End If
' Write the required values from the source values array
' to a 1D one-based array ('dArr').
Dim dArr() As Variant: ReDim dArr(1 To srCount) ' too big
Dim sValue As Variant
Dim sr As Long
Dim dc As Long
For sr = 1 To srCount
sValue = slData(sr, 1)
If VarType(sValue) = vbDouble Then ' is a number
If sValue = 5 Then ' is equal to 5
dc = dc + 1
dArr(dc) = svData(sr, 1)
' Else ' is a number but not equal to 5; do nothing
End If
' Else ' is not a number; do nothing
End If
Next sr
' Resize the destination array (remove the trailing 'empties').
ReDim Preserve dArr(1 To dc)
' Print the contents of the array to the Immediate window ('Ctrl+G').
Debug.Print "Index", "Value"
For dc = 1 To UBound(dArr)
Debug.Print dc, dArr(dc)
Next dc
End Sub