This code should do what you want but check if it doesn't make mistakes.
I didn't check it too much so it may produce errors.
Run it in a copy of workbook.
You should put this into class module and call it 'CItem':
Public pItemDescription As String
Public pSupplier As String
Public pDateDelivery As Collection
https://excelmacromastery.com/vba-class-modules/
That table in 'Analysis' should be empty.
Then this into regular module:
Option Explicit
Sub SortCheck()
Dim aSht As Worksheet
Dim bSht As Worksheet
Dim tempItemDescription As String
Dim tempSupplier As String
Dim tempDateDelivery As String
Dim xItemsAll As Collection
Dim xItem As CItem
Dim xI As Variant
Dim flag As Boolean
Dim xTemp As Variant
Dim i As Long
Dim j As Long
Dim k As Long
Dim Row As Long
Set xItemsAll = New Collection
Set xItem = New CItem
Set aSht = Worksheets("Raw Data")
Set bSht = Worksheets("Analysis")
Row = 2
flag = True
Do
' If the cell is empty, stop populating the collection
If aSht.Cells(Row, 2).Value = "" Then Exit Do
' ---
tempDateDelivery = aSht.Cells(Row, 1).Value
tempItemDescription = aSht.Cells(Row, 2).Value
tempSupplier = aSht.Cells(Row, 3).Value
'If xItemsAll contains some records, check wheter similar records exist
If xItemsAll.Count > 0 Then
For Each xI In xItemsAll
If tempItemDescription = xI.pItemDescription And tempSupplier = xI.pSupplier Then
Set xItem = New CItem
Set xItem = xI
xItem.pDateDelivery.Add tempDateDelivery
Set xItem = Nothing
flag = False
Exit For
Else
flag = True
End If
Next xI
End If
' If the first pass or no element in collection yet, create new record
If flag = True Then
Set xItem = New CItem
With xItem
.pItemDescription = tempItemDescription
.pSupplier = tempSupplier
Set .pDateDelivery = New Collection
.pDateDelivery.Add tempDateDelivery
End With
xItemsAll.Add xItem
Set xItem = Nothing
flag = False
End If
Row = Row + 1
Loop
'Sort the collection - Item Description in order
For i = 1 To xItemsAll.Count - 1
For j = i + 1 To xItemsAll.Count
If xItemsAll(i).pItemDescription > xItemsAll(j).pItemDescription Then
Set xItem = New CItem
Set xItem = xItemsAll(j)
xItemsAll.Remove j
If j <> xItemsAll.Count + 1 Then
xItemsAll.Add xItemsAll(i), , j
Else
xItemsAll.Add xItemsAll(i), , , j - 1
End If
xItemsAll.Remove i
If i <> xItemsAll.Count + 1 Then
xItemsAll.Add xItem, , i
Else
xItemsAll.Add xItem, , , i - 1
End If
Set xItem = Nothing
End If
Next j
Next i
'Sort the collection - Suplier in order
For i = 1 To xItemsAll.Count - 1
For j = i + 1 To xItemsAll.Count
If xItemsAll(i).pItemDescription = xItemsAll(j).pItemDescription Then
If xItemsAll(i).pSupplier > xItemsAll(j).pSupplier Then
Set xItem = New CItem
Set xItem = xItemsAll(j)
xItemsAll.Remove j
If j <> xItemsAll.Count + 1 Then
xItemsAll.Add xItemsAll(i), , j
Else
xItemsAll.Add xItemsAll(i), , , j - 1
End If
xItemsAll.Remove i
If i <> xItemsAll.Count + 1 Then
xItemsAll.Add xItem, , i
Else
xItemsAll.Add xItem, , , i - 1
End If
Set xItem = Nothing
End If
End If
Next j
Next i
'Sort the collection - Dates in order
For k = 1 To xItemsAll.Count
For i = 1 To xItemsAll(k).pDateDelivery.Count - 1
For j = i + 1 To xItemsAll(k).pDateDelivery.Count
If xItemsAll(k).pItemDescription = xItemsAll(k).pItemDescription Then
If xItemsAll(k).pSupplier = xItemsAll(k).pSupplier Then
If xItemsAll(k).pDateDelivery(i) > xItemsAll(k).pDateDelivery(j) Then
xTemp = xItemsAll(k).pDateDelivery(j)
xItemsAll(k).pDateDelivery.Remove j
If j <> xItemsAll(k).pDateDelivery.Count + 1 Then
xItemsAll(k).pDateDelivery.Add xItemsAll(k).pDateDelivery(i), , j
Else
xItemsAll(k).pDateDelivery.Add xItemsAll(k).pDateDelivery(i), , , j - 1
End If
xItemsAll(k).pDateDelivery.Remove i
If i <> xItemsAll(k).pDateDelivery.Count + 1 Then
xItemsAll(k).pDateDelivery.Add xTemp, , i
Else
xItemsAll(k).pDateDelivery.Add xTemp, , , i - 1
End If
End If
End If
End If
Next j
Next i
Next k
Row = 2
For i = 1 To xItemsAll.Count
For j = 1 To xItemsAll(i).pDateDelivery.Count - 1
If CLng(Mid(xItemsAll(i).pDateDelivery(j + 1), 5)) <> (CLng(Mid(xItemsAll(i).pDateDelivery(j), 5)) + 1) Then
bSht.Cells(Row, 1).Value = xItemsAll(i).pDateDelivery(j + 1)
bSht.Cells(Row, 2).Value = xItemsAll(i).pDateDelivery(j)
bSht.Cells(Row, 3).Value = xItemsAll(i).pItemDescription
bSht.Cells(Row, 4).Value = xItemsAll(i).pSupplier
Row = Row + 1
End If
Next j
Next i
End Sub
For the code to work corectly it has to be 201801, 201805, etc. not 20181, 20185, etc. So if you have it different you would have to modify it with functions or vba.
