Sub All_Values_In_Date_Range()
Dim d1 As Object, d2 As Object
Dim a As Variant, aRws As Variant
Dim dStart As Date, dEnd As Date
Dim i As Long, FirstRow As Long, LastRow As Long
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1") '<-Check sheet name & cell addresses
dStart = .Range("D4").Value
dEnd = .Range("D6").Value
End With
With Sheets("Sheet2") '<-Check sheet name & columns
FirstRow = 4 '<- First row of actual data
LastRow = .Range("F" & Rows.Count).End(xlUp).Row
a = Application.Index(.Cells, Evaluate("row(" & FirstRow & ":" & LastRow & ")"), Array(6, 16)) '<- Read cols F & P only into an array
End With
For i = 1 To UBound(a)
If d2.exists(a(i, 1)) Then 'If the col F value is listed in the OUT dict then
If d1.exists(a(i, 1)) Then d1.Remove a(i, 1) 'If it is in the IN dict remove it from the IN dict
Else
If a(i, 2) < dStart Or a(i, 2) > dEnd Then 'If the col P date is outside the date range then
d2(a(i, 1)) = 1 'Add (or re-add, doesn't matter) the col F value to the OUT dict
If d1.exists(a(i, 1)) Then d1.Remove a(i, 1) '.. and if the col F value is in the IN dict remove it from the IN dict
Else
d1(a(i, 1)) = 1 'If we get here then the col P dates are in range and the col F value is not in the OUT dict, so add (or re-add) the col F value to the IN dict
End If
End If
Next i
With Sheets("Sheet3").Columns("A") '<-Check sheet name & column for results
.EntireColumn.ClearContents
.Cells(1).Value = "Results"
If d1.Count > 0 Then
With .Resize(d1.Count).Offset(1)
.Value = Application.Transpose(d1.Keys) 'This writes all the IN dict values into the results sheet ..
.Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo '.. and sorts them
End With
Else
.Cells(2).Value = "N/A" 'Just in case there are no results
End If
End With
End Sub
