Sorting a Large Excel Spreadsheet by Date - Fails on 3rd Iteration - vba

Question

I am new to VBA as a language, and I'm having issues sorting a large spreadsheet. The sheet is roughly 400,000 rows by 8 columns. The relevant data begins on row 5. In Column C, I changed the format of the date and rounded it down to give a single integer representing the day.
The goal is to find where the data changes days, and cut and paste all of that day's data to a seperate tab. The code I have written successfully does this for the first 2 days, but the 3rd iteration and beyond will not work properly. I have used a color code (blue) to represent the last row for each day, and I'm using this color change as my loop condition. The 3rd loop ignores the 1st color change and instead cuts and pastes 2 day's worth of data, and the 4th loop moves 3 days.
Would there be a more efficient way to move each day's data to a new tab? Each day represents 28800 rows by 6 columns. It should be noted that an additional macro is run before this in order to simply organize the raw data. The portion of the code giving me issues are the loops following the "Sort the data by date" comment.
Any help would be greatly appreciated! Thanks in advance. Attached is my code and a sample of the data
Sub HOBO_Split_v2()
'Before this code can be run, you must run "Hobo_Organize" 1 time. Press 'Ctrl + Shift + O' to do this
'The purpose of this code is to separate the hobo data by day. Weekends and evenings will be removed.
'This will create smaller data sets, which allows for easier data manipulation
Application.ScreenUpdating = False
'Find the last row
Lastrow = Range("C" & Rows.Count).End(xlUp).Row
'Set the known parameters
Dim days As Range
Set days = Worksheets("Full Data Set").Range("C5:C" & Lastrow)
Dim daychanges As String
daychanges = 0
'Maximum of 3 weeks of data, 21 different sheets
Dim sheetnum(1 To 21) As Integer
For i = 1 To 21
sheetnum(i) = i
Next i
'Loop through the day index (Col C), counting the number of day changes
For Each cell In days
If cell.Value <> cell.Offset(1).Value Then
cell.Interior.ColorIndex = 37
daychanges = daychanges + 1
End If
Next cell
'Add new sheets for each day and rename the sheets
Sheets.Add after:=ActiveSheet
ActiveSheet.Name = "Day 1"
For i = 2 To daychanges
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "Day " & sheetnum(i)
Next i
Sheets("Full Data Set").Select
'Sort the data by date
For Each cell In days
If cell.Interior.ColorIndex = 37 Then
cell.Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Worksheets(Worksheets.Count).Select
ActiveSheet.Range("B2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Move Before:=Sheets("Full Data Set")
Sheets("Full Data Set").Select
Range("C4").Select
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlDown)).Select
Set days = Selection
End If
Next cell
Application.ScreenUpdating = True
End Sub
Example of the data

Answer 1

I'd not pass through any cell coloring and use RemoveDuplicates() method of Range object as like follows:
Option Explicit
Sub HOBO_Split_v2()
Dim datesRng As Range, dataRng As Range, cell As Range
Dim iDay As Long
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Full Data Set")
Set datesRng = .Range("C5", .Cells(.Rows.Count, 3).End(xlUp)) '<--| set dates range
Set dataRng = datesRng.offset(-1).Resize(datesRng.Rows.Count + 1, 6) '<--| set data range as dates one extended to next 5 columns
With datesRng.offset(, .UsedRange.Columns.Count) '<--| use a helper column out of current used range
.value = datesRng.value '<--| copy dates value in helper column
.RemoveDuplicates Columns:=Array(1) '<--| remove duplicates and have only unique values in helper column
For Each cell In .Cells.SpecialCells(xlCellTypeConstants, xlNumbers) '<--| iterate through remaining (unique) day values in helper column
iDay = iDay + 1 '<--| update "current day" counter
dataRng.AutoFilter Field:=1, Criteria1:=Format(cell, "#.00") '<--| filter data by "current day", format the criteria as the actual column C cells format
dataRng.offset(1).Resize(dataRng.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=SetWorkSheet(ThisWorkbook, "Day " & iDay).Range("B2") '<--| copy filtered data and paste the into "current day" corresponding sheet
Next cell
.Parent.AutoFilterMode = False '<--| remove autofilter
.Clear '<--| clear helper column
End With
End With
Application.ScreenUpdating = True
End Sub
Function SetWorkSheet(wb As Workbook, SheetName As String) As Worksheet
On Error Resume Next
Set SetWorkSheet = wb.Worksheets(SheetName)
On Error GoTo 0
If SetWorkSheet Is Nothing Then
Set SetWorkSheet = wb.Worksheets.Add(after:=wb.Worksheets(wb.Worksheets.Count))
SetWorkSheet.Name = SheetName
Else
SetWorkSheet.UsedRange.Clear '<--| clear preceeding values in already existent sheet
End If
End Function

Answer 2

There is no need to iterate over the list twice. GetWorkSheet create the new worksheets for you if they don't exist and handle any errors.
Sub HOBO_Split_v2()
Application.ScreenUpdating = False
Dim cell As Range, days As Range
Dim lFirstRow As Long, Lastrow As Long
Dim SheetName As String
Dim ws As Worksheet
With Sheets("Full Data Set")
Lastrow = Range("C" & Rows.Count).End(xlUp).Row
Set days = .Range("C5:C" & Lastrow)
For Each cell In days
If c.Text <> SheetName Or c.Row = Lastrow Then
If lFirstRow > 0 Then
Set ws = getWorkSheet(SheetName)
.Range("A" & lFirstRow, "A" & cell.Row).EntireRow.Copy ws.Range("A1")
End If
SheetName = c.Text
lFirstRow = i
End If
Next
End With
Application.ScreenUpdating = True
End Sub
Function getWorkSheet(SheetName As String) As Worksheet
Dim ws As Worksheet
On Error Resume Next
Set ws = Worksheets(SheetName)
If ws Is Nothing Then
Set ws = Worksheets.Add(after:=ActiveSheet)
ws.Name = SheetName
End If
On Error GoTo 0
Set getWorkSheet = ws
End Function