Report to show >2 Instances of an Absence

[alu]

Hi all,

I have a spreadsheet with the following columns:

Student_ID; Name; Course_ID; Date; Attendance (X for Absent, O for Present)

I am trying to automate a report Showing and Student that has been absent for 3 or more consecutive absences.

Currently I am able to do this manually. I have had successs semi automating the process with Macro recorder, although the amount of code it produces runs into many hundreds of lines - For brevity I have not posted this code here.

Could anyone offer advice or pointers to help me writing a more efficent solution to this?

Kind reagrds

Alu

[Bob Phillips]

Post an example of the data and wanted results.

[alu]

this (http://spreadsheets.google.com/ccc?key=rc22Kd0eqOsLCbEHg0QE1tA&hl=en) is an example of a large spreadsheet i have (Sheet 1).

I would like to be able to automatically sort it so the only students I have left are those which have 3 consecutive absences (shown as an X in column F).

in the example shown I would be left with the same data but only only Susan Mear & Tony Maar (Sheet 2)

I have tried playing with Auto-Filter but its not any absence im after, its those with 3 consecutive ones. I am unable to find a good approach to automating this problem.

[Bob Phillips]

Don't have access to see the file.

[alu]

Thankyou in advance for any help or advice.

As attached.

edit: The way I am doing it at the moment is going to the last cell in the range, holding Ctrl+shift+UP+Right+Right to select each student data set, then running Auto Filter to see if there are any X's in the Attendance column - i'm sure there must be a better way!

[Bob Phillips]

Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long
Dim StartRow As Long
Dim NumAbs As Long
Dim rng As Range

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With ActiveSheet

LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = 4 To LastRow + 1

If .Cells(i, "B").Value <> "" Or i > LastRow Then

If i <> 4 Then

If NumAbs < 3 Then

If rng Is Nothing Then

Set rng = .Rows(StartRow).Resize(i - StartRow)
Else

Set rng = Union(rng, .Rows(StartRow).Resize(i - StartRow))
End If
End If
End If

StartRow = i
NumAbs = 0
End If

If .Cells(i, "G") = "X" Then NumAbs = NumAbs + 1
Next i

If Not rng Is Nothing Then rng.Delete
End With

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub