```
Sub Count_Slot_Items()
Dim LR As Long, i As Long, FindDate As Date
Dim Rng As Range
Application.ScreenUpdating = False
Sheets("Sheet2").Columns("A:L").Clear
FindDate = Sheets("Sheet1").Range("C1").Value
With Sheets("Sheet1").Range("D1:IV1")
Set Rng = .Find(What:=FindDate, After:=.Cells(1, .Columns.Count), LookIn:=xlValues, LookAt:=xlWhole _
, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not Rng Is Nothing Then
For i = 0 To 10 Step 2
If Range(Rng.Offset(1, i / 2), Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, _
Rng.Column + i / 2).End(xlUp)).Cells.Count > 1 Then
Range(Rng.Offset(1, i / 2), Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, _
Rng.Column + i / 2).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("Sheet2").Cells(1, i + 1), Unique:=True
Sheets("Sheet2").Cells(1, i + 1).Value = "Slot " & Sheets("Sheet2").Cells(1, i + 1).Value
Sheets("Sheet2").Cells(1, i + 2).Value = "Count"
LR = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, i + 1).End(xlUp).Row
If LR > 2 Then
For j = 2 To LR
Sheets("Sheet2").Cells(j, i + 2).Value = WorksheetFunction.CountIf( _
Range(Rng.Offset(1, i / 2), Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, _
Rng.Column + i / 2).End(xlUp)), _
Sheets("Sheet2").Cells(j, i + 1).Value)
Next j
Else
Sheets("Sheet2").Cells(2, i + 2).Value = WorksheetFunction.CountIf( _
Range(Rng.Offset(1, i / 2), Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, _
Rng.Column + i / 2).End(xlUp)), _
Sheets("Sheet2").Cells(2, i + 1).Value)
End If
Else
Sheets("Sheet2").Cells(1, i + 1).Value = "Slot " & Rng.Offset(1, i / 2).Value
Sheets("Sheet2").Cells(1, i + 2).Value = "Count"
End If
Next i
End If
End With
Sheets("Sheet2").Columns.AutoFit
Application.ScreenUpdating = True
End Sub
```