How could I add this to an array?

Question

I've been trying to add the entire row that meets the highlight criteria to an array but I've been struggling getting it to work.

The code loops through multiple identifiers and highlight them in red based off of the preconditions. I would like to add the entire row to an array for all rows meeting the precondition criteria.

Sub SWAPS101()
        'red color
   ' If "Security Type" = SW
  '  If "New Position Ind" = N
 '   If "Prior Price" = 100
'    If "Current Price" does not equal 100

Dim rng As Range, lCount As Long, LastRow As Long
Dim cell As Object

'Sheets("Output").Activate

With ActiveSheet

    LastRow = .Cells(Rows.Count, 1).End(xlUp).Row

    For Each cell In .Range("E2:E" & LastRow) 'new position
        If cell = "N" And cell.Offset(, 16) = "SW" And cell.Offset(, 5) = 100 _
            And cell.Offset(, 4) <> 100 Then
            With cell.EntireRow.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 6382079
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With

'            LastRow = Range("b65000").End(xlUp).Row
'                For r = 2 To LastRow
                        Row = Row + 1
                            TempArray(Row, 1) = Cells(r, cell)) 


            Next r

        End If
    Next cell


End With
End Sub

Answer 1

My idea is to create union range uRng but I couldn't fill it in array so create temp sheet and past this range in it then fill the selection (the copied range) in array then delete this temp sheet.

this will work but I don't know if it is good way so this is just an idea because Jeeped answer seems the full answer for this question

Sub SWAPS101()
        'red color
   ' If "Security Type" = SW
  '  If "New Position Ind" = N
 '   If "Prior Price" = 100
'    If "Current Price" does not equal 100

Dim rng As Range, lCount As Long, LastRow As Long
Dim cell As Range
Dim TempArray As Variant, uRng As Range, tempSH As Worksheet

'Sheets("Output").Activate

With ActiveSheet

    LastRow = .Cells(Rows.Count, 1).End(xlUp).Row

    For Each cell In .Range("E2:E" & LastRow) 'new position
        If cell = "N" And cell.Offset(, 16) = "SW" And cell.Offset(, 5) = 100 _
            And cell.Offset(, 4) <> 100 Then
            With cell.EntireRow.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 6382079
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With

                If uRng Is Nothing Then
                 Set uRng = cell.EntireRow
                Else
                 Set uRng = Union(uRng, cell.EntireRow)
                End If

        End If
    Next cell


End With

  If Not uRng Is Nothing Then
         Application.ScreenUpdating = False
         Set tempSH = Sheets.Add
         uRng.Copy
         tempSH.Paste
         TempArray = Selection.Value
         Application.DisplayAlerts = False
         tempSH.Delete
         Application.DisplayAlerts = True
         Application.ScreenUpdating = True
  End If

End Sub

Answer 2

Using the Range.CurrentRegion property to isolate the 'island' of data radiating out from A1 is an easy method to restrict the 'scope' of the operation. You do not want to be copying thousands of blank cells into an array.

Sub SWAPS101()
        'red color
   ' If "Security Type" = SW
  '  If "New Position Ind" = N
 '   If "Prior Price" = 100
'    If "Current Price" does not equal 100
    Dim a As Long, r As Long, c As Long, vVALs As Variant

    With Sheets("Output")
        'reset the environment
        If .AutoFilterMode Then .AutoFilterMode = False
        .Columns(5).Interior.Pattern = xlNone
        With .Cells(1, 1).CurrentRegion
            ReDim vVALs(1 To .Columns.Count, 1 To 1)
            .AutoFilter field:=Application.Match("security type", .Rows(1), 0), Criteria1:="SW"
            .AutoFilter field:=Application.Match("new position ind", .Rows(1), 0), Criteria1:="N"
            .AutoFilter field:=Application.Match("prior price", .Rows(1), 0), Criteria1:=100
            .AutoFilter field:=Application.Match("current price", .Rows(1), 0), Criteria1:="<>" & 100
            With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
                'check to ensure that there is something to work with
                If CBool(Application.Subtotal(103, .Cells)) Then
                    With Intersect(.Columns(5), .SpecialCells(xlCellTypeVisible))
                        .Cells.Interior.Color = vbRed
                    End With
                    Debug.Print .SpecialCells(xlCellTypeVisible).Areas.Count
                    With .SpecialCells(xlCellTypeVisible)
                        For a = 1 To .Areas.Count
                            Debug.Print .Areas(a).Rows.Count
                            For r = 1 To .Areas(a).Rows.Count
                                Debug.Print .Areas(a).Rows(r).Address(0, 0)
                                ReDim Preserve vVALs(1 To UBound(vVALs, 1), 1 To UBound(vVALs, 2) + 1)
                                For c = 1 To .Columns.Count
                                    vVALs(c, UBound(vVALs, 2)) = _
                                        .Areas(a).Rows(r).Cells(1, c).Value
                                Next c
                            Next r
                        Next a
                        vVALs = Application.Transpose(vVALs)
                    End With

                    'array is populated - do something with it
                    Debug.Print LBound(vVALs, 1) & ":" & UBound(vVALs, 1)
                    Debug.Print LBound(vVALs, 2) & ":" & UBound(vVALs, 2)
                    'this dumps the values starting a couple of rows down
                    With .Cells(.Rows.Count, 1).Offset(3, 0)
                        .Resize(UBound(vVALs, 1), UBound(vVALs, 2)) = vVALs
                    End With
                End If
            End With
        End With
        If .AutoFilterMode Then .AutoFilterMode = False
    End With

End Sub

I've left a lot of the debug.print statements in so you can watch how the process loops through the rows of each Range.Areas property within the Range.SpecialCells method's xlCellTypeVisible set. Use F8 to step through the code while keeping an eye on the VBE's Immediate window ([Ctrl]+G).

        
                ^{Post-processing results}

Answer 3

You can add ranges to an array, such as:

Dim myArray() As Variant 'declare an unallocated array.
myArray = Range("E2:E" & LastRow) 'myArray is now an allocated array, range being your row