Macro auto filter to create report pasting hidden rows. Help

[DBR138]

I have been working on this macro for ages and have learned a lot but now I am completely stuck. I have my source data filtering correctly at this point but when it pastes the data into the report it is including the hidden lines and negating the filter. I assume this has something to do with my range but I can't figure it out. Pasting the code below. If anyone could help me get past this I would be forever grateful. If you need any additional information I will provide it as soon as possible.

Public Sub CreatePassOn()

    
    Dim wb As Workbook
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Const filterField1 As Long = 8
    Const filterField2 As Long = 27
    Const criterion1 As String = "QC-Completed"
    Const criterion2 As String = vbNullString
    Set wb = ThisWorkbook
    Set wsSource = wb.Worksheets("Data")
    Set wsTarget = wb.Worksheets("Pass On")
    Dim lastRowSource As Long
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    Dim lastColumnSource As Long
    lastColumnSource = wsSource.Range("A1").SpecialCells(xlCellTypeLastCell).Column
    Dim filterRange As Range
    Set filterRange = wsSource.Range(wsSource.Cells(1, 1), wsSource.Cells(lastRowSource, lastColumnSource))
    wsSource.AutoFilterMode = False
    Dim dataArray As Variant
    With filterRange
         .AutoFilter
        .AutoFilter Field:=filterField1, Criteria1:="<>" & criterion1, Operator:=xlFilterValues
        .AutoFilter Field:=filterField2, Criteria1:=criterion2
        With wsSource.AutoFilter.Range
             dataArray = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) 'exclude header
        End With
    End With
    Application.CutCopyMode = False              'Clear clipboard
    Dim columnsToKeep() As Variant
    columnsToKeep = Array(13, 36, 2, 3, 24, 8, 12) 'determine output columns to keep and their order
    Dim currentRow As Long
    Dim currentColumn As Long
    Dim resultArray() As Variant
    ReDim resultArray(1 To UBound(dataArray, 1), 1 To UBound(columnsToKeep) + 1)
    Dim columnCounter As Long
    For currentRow = LBound(dataArray, 1) To UBound(dataArray, 1)
        columnCounter = 0
        For currentColumn = LBound(columnsToKeep) To UBound(columnsToKeep)
            columnCounter = columnCounter + 1
            resultArray(currentRow, columnCounter) = dataArray(currentRow, columnsToKeep(currentColumn))
        Next currentColumn
    Next currentRow
    wsTarget.Range("A2").Resize(UBound(resultArray, 1), UBound(resultArray, 2)) = resultArray
MsgBox "Pass on creation succesful! Please update your comments and print."
End Sub

[DBR138]

I suspect that the problem lies within the following smaller section of code. Perhaps I need to redefine my range after applying the filter instead of using dataArray again?

With filterRange
         .AutoFilter
        .AutoFilter Field:=filterField1, Criteria1:="<>" & criterion1, Operator:=xlFilterValues
        .AutoFilter Field:=filterField2, Criteria1:=criterion2
                            
With wsSource.AutoFilter.Range
             dataArray = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)  'exclude header
        End With
    End With
    Application.CutCopyMode = False              'Clear clipboard
    Dim columnsToKeep() As Variant
    columnsToKeep = Array(13, 36, 2, 3, 24, 8, 12) 'determine output columns to keep and their order
    Dim currentRow As Long
    Dim currentColumn As Long
    Dim resultArray() As Variant
    ReDim resultArray(1 To UBound(dataArray, 1), 1 To UBound(columnsToKeep) + 1)
    Dim columnCounter As Long
    For currentRow = LBound(dataArray, 1) To UBound(dataArray, 1)
        columnCounter = 0
        For currentColumn = LBound(columnsToKeep) To UBound(columnsToKeep)
            columnCounter = columnCounter + 1
            resultArray(currentRow, columnCounter) = dataArray(currentRow, columnsToKeep(currentColumn))
        Next currentColumn
    Next currentRow
    wsTarget.Range("A2").Resize(UBound(resultArray, 1), UBound(resultArray, 2)) = resultArray

[p45cal]

try (untested):

Public Sub CreatePassOn()
Dim wb As Workbook
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim ResultRowCount As Long
Const filterField1 As Long = 8
Const filterField2 As Long = 27
Const criterion1 As String = "QC-Completed"
Const criterion2 As String = vbNullString
Dim columnsToKeep() As Variant
Dim currentRow As Long
Dim currentColumn As Long
Dim resultArray() As Variant
Dim columnCounter As Long

Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Data")
Set wsTarget = wb.Worksheets("Pass On")
Dim lastRowSource As Long
lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
Dim lastColumnSource As Long
lastColumnSource = wsSource.Range("A1").SpecialCells(xlCellTypeLastCell).Column
Dim filterRange As Range
Set filterRange = wsSource.Range(wsSource.Cells(1, 1), wsSource.Cells(lastRowSource, lastColumnSource))
wsSource.AutoFilterMode = False
Dim dataArray As Variant
With filterRange
  '  .AutoFilter
  '  .AutoFilter Field:=filterField1, Criteria1:="<>" & criterion1, Operator:=xlFilterValues
  '  .AutoFilter Field:=filterField2, Criteria1:=criterion2
  '  With wsSource.AutoFilter.Range
  dataArray = .Offset(1).Resize(.Rows.Count - 1)    'exclude header
  '  End With
End With
'Application.CutCopyMode = False    'Clear clipboard
columnsToKeep = Array(13, 36, 2, 3, 24, 8, 12)    'determine output columns to keep and their order
ReDim resultArray(1 To UBound(dataArray, 1), 1 To UBound(columnsToKeep) + 1)
ResultRowCount = 0
For currentRow = LBound(dataArray, 1) To UBound(dataArray, 1)
  If dataArray(currentRow, filterField1) <> criterion1 And dataArray(currentRow, filterField2) = criterion2 Then
    ResultRowCount = ResultRowCount + 1
    columnCounter = 0
    For currentColumn = LBound(columnsToKeep) To UBound(columnsToKeep)
      columnCounter = columnCounter + 1
      resultArray(ResultRowCount, columnCounter) = dataArray(currentRow, columnsToKeep(currentColumn))
    Next currentColumn
  End If
Next currentRow
wsTarget.Range("A2").Resize(ResultRowCount, UBound(resultArray, 2)) = resultArray
MsgBox "Pass on creation succesful! Please update your comments and print."
End Sub

When you assign values to dataArray it ignores that rows are hidden. So I ditched the Autofilter and did that in code instead.

Using Advanced Filter in VBA would probably be easier and shorter.

[p45cal]

With advanced filter:

Sub CreatePassOnAdvFilter()
Dim wb As Workbook, wsSource As Worksheet, wsTarget As Worksheet
Dim columnsToKeep() As Variant, colm As Long, v, Destn As Range, CritRangeTopLeft As Range, CritRangeBottomRight As Range, CritRange As Range
Dim lastColumnSource As Long, lastRowSource As Long, filterRange As Range
Const filterField1 As Long = 8
Const filterField2 As Long = 27
Const criterion1 As String = "QC-Completed"
Const criterion2 As String = vbNullString

Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Data")
Set wsTarget = wb.Worksheets("Pass On")
On Error Resume Next: wsSource.ShowAllData: On Error GoTo 0
lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
lastColumnSource = wsSource.Range("A1").SpecialCells(xlCellTypeLastCell).Column
Set filterRange = wsSource.Range(wsSource.Cells(1, 1), wsSource.Cells(lastRowSource, lastColumnSource))
columnsToKeep = Array(13, 36, 2, 3, 24, 8, 12)    'determine output columns to keep and their order
'this next section puts the headers on row 1 of the Pass On sheet:
colm = 0
For Each v In columnsToKeep
  colm = colm + 1
  wsTarget.Cells(1, colm).Value = wsSource.Cells(1, v)
Next v

Set Destn = Range(wsTarget.Cells(1, 1), wsTarget.Cells(1, colm))    'for the advanced filter later.

'Now set up Criteria range for Advanced Filter:
colm = colm + 2
wsTarget.Cells(1, colm).Value = wsSource.Cells(1, filterField1)
Set CritRangeTopLeft = wsTarget.Cells(1, colm)
wsTarget.Cells(2, colm).Value = "<>" & criterion1
colm = colm + 1
wsTarget.Cells(1, colm).Value = wsSource.Cells(1, filterField2)
wsTarget.Cells(2, colm).Value = "=" & criterion2
Set CritRangeBottomRight = wsTarget.Cells(2, colm)
Set CritRange = Range(CritRangeTopLeft, CritRangeBottomRight)

'Now do the filtering:
filterRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=CritRange, CopyToRange:=Destn, Unique:=False

'tidy up:
CritRange.Clear
End Sub

[p45cal]

Before anyone else thinks of spending significant time on this, this question has been cross posted elsewhere.

[DBR138]

This is so much cleaner. I had no idea. Thank you very much! I have a lot to play with now.

With advanced filter:

Sub CreatePassOnAdvFilter()
Dim wb As Workbook, wsSource As Worksheet, wsTarget As Worksheet
Dim columnsToKeep() As Variant, colm As Long, v, Destn As Range, CritRangeTopLeft As Range, CritRangeBottomRight As Range, CritRange As Range
Dim lastColumnSource As Long, lastRowSource As Long, filterRange As Range
Const filterField1 As Long = 8
Const filterField2 As Long = 27
Const criterion1 As String = "QC-Completed"
Const criterion2 As String = vbNullString

Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Data")
Set wsTarget = wb.Worksheets("Pass On")
On Error Resume Next: wsSource.ShowAllData: On Error GoTo 0
lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
lastColumnSource = wsSource.Range("A1").SpecialCells(xlCellTypeLastCell).Column
Set filterRange = wsSource.Range(wsSource.Cells(1, 1), wsSource.Cells(lastRowSource, lastColumnSource))
columnsToKeep = Array(13, 36, 2, 3, 24, 8, 12)    'determine output columns to keep and their order
'this next section puts the headers on row 1 of the Pass On sheet:
colm = 0
For Each v In columnsToKeep
  colm = colm + 1
  wsTarget.Cells(1, colm).Value = wsSource.Cells(1, v)
Next v

Set Destn = Range(wsTarget.Cells(1, 1), wsTarget.Cells(1, colm))    'for the advanced filter later.

'Now set up Criteria range for Advanced Filter:
colm = colm + 2
wsTarget.Cells(1, colm).Value = wsSource.Cells(1, filterField1)
Set CritRangeTopLeft = wsTarget.Cells(1, colm)
wsTarget.Cells(2, colm).Value = "<>" & criterion1
colm = colm + 1
wsTarget.Cells(1, colm).Value = wsSource.Cells(1, filterField2)
wsTarget.Cells(2, colm).Value = "=" & criterion2
Set CritRangeBottomRight = wsTarget.Cells(2, colm)
Set CritRange = Range(CritRangeTopLeft, CritRangeBottomRight)

'Now do the filtering:
filterRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=CritRange, CopyToRange:=Destn, Unique:=False

'tidy up:
CritRange.Clear
End Sub