Hi
Datadump? right worksheet??
Describe what your code does and then what you want it to do. There are
no mind readers here...apart from Tom Ogilvy maybe...or Bob Philips...

regards
Paul

Sjakkie wrote:

I have adapted the below script to create a worksheet per team and then list
all. it allows to list all apart from the teams where there is only one entry
in the datadump. is there any way where i can modify it to still paste the
entry into the right worksheet.


Sub SplitDump()
Dim sh As Worksheet, s As String
Dim i As Long
Dim c As Range
Dim strAddress As String
Dim test As Integer
Dim cnt As Long
Dim lRow As Long 'Last Row


strMain = ActiveSheet.Name
i = 2

For Each c In Range("d2:d5000")
strAddress = c.Address
If Len(c.Value) = 0 Then
Call DeleteRow
MsgBox ("Finished")
Exit Sub
End If
If Len(c.Value) 31 Then
c.Value = Trim(Right(c.Value, Len(c.Value) - 1))
Exit Sub
End If


If InStr(1, c.Value, "") Then
s = Trim(Left(c, Len(c) - 5))
iloc = InStr(1, s, "/", vbTextCompare)
If iloc < 0 Then
s = Trim(Left(s, iloc - 2))
End If
Set sh = Nothing
On Error Resume Next
Set sh = Sheets(s)
On Error GoTo 0

If sh Is Nothing Then
'it doesn't exist, so add it
Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
sh.Name = s
i = 3
Else
c.Resize(c.Rows.Count + 1, 20).Offset(-1, -3).Copy sh.Cells(i, "a")
i = i + 1
End If
End If
Next c


End Sub