Copy the data to an array, filter to another array, and copy back to the sheet. 20,000 rows should take a few seconds.
Function AgedDivert()
Dim wb As Workbook
Dim wsData As Worksheet, wsReport As Worksheet, wsTemp As Worksheet
Dim arData, arReport
Dim lastrow As Long, i As Long, r As Long
Dim colC, colD, colI, colJ, colK, colM, msg As String
Dim t0 As Single: t0 = Timer
Const RPT_NAME = "Aged Divert Report"
'Pull from scraped data to display compact data set
On Error GoTo ErrorHandler
Set wb = ThisWorkbook
With wb
Set wsData = .Sheets("Scraped Data")
Set wsReport = .Sheets(RPT_NAME)
Set wsTemp = .Sheets("Temp")
End With
' copy data
With wsData
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
' copy sheet to array
arData = .Range("A1:P" & lastrow)
ReDim arReport(1 To lastrow, 1 To 6) ' A to F
For i = 2 To lastrow
colC = arData(i, 3)
colD = arData(i, 4)
colI = arData(i, 9)
colJ = arData(i, 10)
colK = arData(i, 11)
colM = arData(i, 13)
'Filter out Direct Loads, PA2, Less than 180 Minutes,
'Secondary, not diverted
If Len(colD) <> 2 And colD <> "" And _
(colJ = "Ship Sorter" Or colK = "Divert Confirm") _
And colM > 180 _
And colI <> "Left to Pick" _
And InStr(1, colC, "Location") = 0 And _
(InStr(1, colC, "Warehouse A") > 0 Or _
InStr(1, colC, "Warehouse C") > 0 Or _
InStr(1, colC, "PA") = 0) Then
r = r + 1 ' report row
arReport(r, 1) = arData(i, 1) ' A
arReport(r, 2) = arData(i, 4) ' D
arReport(r, 3) = arData(i, 7) ' G
arReport(r, 4) = arData(i, 9) ' I
arReport(r, 5) = arData(i, 13) ' M
arReport(r, 6) = arData(i, 16) ' P
End If
Next i
End With
' output
With wsReport
' delete existing table
.Rows("30:" & .Rows.Count).Clear
.Range("A30:F30") = Array("Col A", "Col D", "Col G", "Col I", "Col M", "Col P")
If r = 0 Then
MsgBox "No data to report", vbExclamation
Else
' copy rows and set Data as Table
.Range("A31").Resize(r, 6) = arReport
.ListObjects.Add(xlSrcRange, .Range("A30:F" & 30 + r), xlYes).Name = "AgedDivert"
End If
End With
msg = lastrow - 1 & " rows scanned from " & wsData.Name & vbLf & _
r & " rows copied to " & wsReport.Name
MsgBox msg, vbInformation, Format(Timer - t0, "0.0 secs")
AgedDivert = True
Exit Function
ErrorHandler:
AgedDivert = False
Debug.Print "Error occured in Aged Divert"
Debug.Print Err.Number & ": " & Err.Description
End Function
