Sub macExpiries()
Application.ScreenUpdating = False
On Error Resume Next
Dim MySheet As Worksheet: Set MySheet = Sheets("Expiries")
Dim MyReferenceCell As Range: MyReferenceCell = Empty
Dim MyReferenceRow As Long: MyReferenceRow = 0
Dim MyCell As Range: MyCell = Empty
Dim MyDictionary As Object: Set MyDictionary = CreateObject("Scripting.Dictionary")
Dim MyKeys As Variant: MyKeys = Empty
Dim MyItems As Variant: MyItems = Empty
Dim MyTable() As Variant: MyTable = Empty
Dim i As Long: i = 0
Dim j As Long: j = 0
Dim k As Long: k = 1
Dim MyReferenceColumn As Long: MyReferenceColumn = 0
Dim MaxRow As Long: MaxRow = 0
If Err <> 0 Then Sheets.Add.Name = "Expiries"
On Error GoTo 0
Etc...