List Breakdown

[Dishboy09]

I have a list of names from the 5 teams in my division in alphabetical order. I would like to have a macro that pulls just my teams names and info from the list and places it onto a separate sheet for easy reading.

How would i set this up?

Thanks

 

[ranman256]

adjust cell locations as needed

Sub aScanTeamList()
Dim vTeam, vPlayer
Dim colTeams As New Collection
Dim colPlayers As New Collection
Dim itm
Dim i As Integer

On Error GoTo ErrScan

Sheets("sheet1").Select
Range("A2").Select
While ActiveCell.Value <> ""
      vTeam = ActiveCell.Offset(0, 0).Value
    vPlayer = ActiveCell.Offset(0, 1).Value
        
    colTeams.Add vTeam, vTeam
    colPlayers.Add vTeam & ":" & vPlayer
    
     ActiveCell.Offset(1, 0).Select    'next row
Wend


  'create the sheet
For Each itm In colTeams
   Sheets.Add
   ActiveSheet.Name = itm
Next


  'post the teams
For Each itm In colPlayers
   i = InStr(itm, ":")
   vTeam = Left(itm, i - 1)
   vPlayer = Mid(itm, i + 1)
   Sheets(vTeam).Select
   ActiveCell.Offset(0, 0).Value = vPlayer
   ActiveCell.Offset(0, 1).Value = vTeam
   ActiveCell.Offset(1, 0).Select    'next row
Next


Exit Sub
ErrScan:
If Err = 457 Or Err = 1004 Then Resume Next  'already in collection or (sheet exists 1004)
MsgBox Err.Description, , Err
End Sub

 

[Dishboy09]

Please excuse my ignorance in this matter, but where in the code do you set the name of the members to move?

adjust cell locations as needed

Sub aScanTeamList()
Dim vTeam, vPlayer
Dim colTeams As New Collection
Dim colPlayers As New Collection
Dim itm
Dim i As Integer

On Error GoTo ErrScan

Sheets("sheet1").Select
Range("A2").Select
While ActiveCell.Value <> ""
      vTeam = ActiveCell.Offset(0, 0).Value
    vPlayer = ActiveCell.Offset(0, 1).Value
        
    colTeams.Add vTeam, vTeam
    colPlayers.Add vTeam & ":" & vPlayer
    
     ActiveCell.Offset(1, 0).Select    'next row
Wend


  'create the sheet
For Each itm In colTeams
   Sheets.Add
   ActiveSheet.Name = itm
Next


  'post the teams
For Each itm In colPlayers
   i = InStr(itm, ":")
   vTeam = Left(itm, i - 1)
   vPlayer = Mid(itm, i + 1)
   Sheets(vTeam).Select
   ActiveCell.Offset(0, 0).Value = vPlayer
   ActiveCell.Offset(0, 1).Value = vTeam
   ActiveCell.Offset(1, 0).Select    'next row
Next


Exit Sub
ErrScan:
If Err = 457 Or Err = 1004 Then Resume Next  'already in collection or (sheet exists 1004)
MsgBox Err.Description, , Err
End Sub

 

[mikerickson]

Have you looked at AdvancedFilter and its copy to other location feature?
Or you could just use Autofilter to show just your team's and then copy/paste

 

[ranman256]

in my example,
Team is in Col.A
player is in Col.B

vPlayer = ActiveCell.Offset(0, 1).Value