Try this. It's adapted from some old code of mine, so I realize that temporarily coloring a cell to indicate it's been used isn't the best method. But this should work.
Sub m_g_gilliland()
Application.ScreenUpdating = False
i = 2
Header = Array("Student ID", "Last, First", "Last Name", "First Name", "State Student ID", _
"Intervention Name", "Intervention Start Date", "Intervention", "End Date", "Date Minutes", _
"Recieved Intervention", "Comments")
Do Until Cells(i, 1).Value = ""
If Cells(i, 1).Interior.Color <> vbRed Then
ID = Cells(i, 1).Value
Set ws = Sheets.Add(After:=ActiveSheet)
ws.Name = Cells(i, 2).Value
ws.Range("A1:L1").Value = Header
OpenRow = 2
Set c = Range("A:A").Find(ID)
If Not c Is Nothing Then
FirstAdd = c.Address
Do
c.EntireRow.Copy ws.Rows(OpenRow)
OpenRow = OpenRow + 1
c.Interior.Color = vbRed
Set c = Range("A:A").FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAdd
End If
End If
i = i + 1
Loop
Range("A:A").Interior.Color = xlNone
Application.ScreenUpdating = True
End Sub
Bookmarks