Team results problem

[sh1pley]

I am trying to compile some cross country team results. The race is split into two divisions. A team consists of 12 runners and Team Shipley has a team in division 1 and a team in division 2.

What I need to be able to do is cut the first 12 Team Shipley runners from the results sheet and paste into a new sheet to become the division 1 results leaving the rest as division 2 results.

Also if for example Team Shipley only had 7 runners then I would need to cut only those 7 from the results sheet so its not always 12 each time.

What I thought I would have to do is sort the results by Team name first and then have some VBA code to cut the runners I need from the results?

I hope this is clear?!

 

[Richard Schollar]

Hi Shipley

What format do the results come thru as? Is it a 'standard' data table ie fileds across the columns records in individual rows? If so, some form of Autofilter code would seem most appropriate.

Perhaps you could post a small sample of the data using one of the html makers?

 

[sh1pley]

The data is very straight forward. It comes in an excel sheet with:

Poisition, Name of runner, Team, Time

 

[Paddy1979]

Ship,

How can you differentiate between Team Shipley division 1 and Team Shipley division 2 in the table?

 

[sh1pley]

This is the tricky bit. Anyone in team Shipley can be in division 1. The first 12 runners to finish from Team Shipley become division 1, all the rest will then become division 2

So I need a way to go down the results and cut these 12 runners from the results to leave the division 2 runners

 

[Paddy1979]

I think this will do the trick it works from the bottom upwards and ignores the first 12 Team Shipleys it finds then cuts and pastes any others it finds onto sheet2

Sub cutship()

Dim c As Long
Dim n As Integer
Dim i As Integer

finalrow = Range("c" & Rows.Count).End(xlUp).Row
n = 1
i = 0

With Range("A1:D" & finalrow)
    .Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With

For c = finalrow To 1 Step -1
 If Cells(c, "C").Value = "Team Shipley" Then
   i = i + 1
   If i < 13 Then GoTo here
   Rows(c).Cut Sheets("Sheet2").Range("A" & n)
   n = n + 1
 End If
here:
Next c


End Sub

 

[sh1pley]

Legend!