How could I add this to an array? - vba

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

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 2

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

Answer 3

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