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

Hi
c.Resize(c.Rows.Count + 1, 20).Offset(-1, -3).Copy sh.Cells(i, "a")

c.rows.count will always be 1, as it counts the number of rows in c
(one cell).
Do you mean c.row?
Cells(i, "a") should be Cells(i,1).

hope that might help
Paul

Sjakkie wrote:

the script allows a datadump which is a dump of all the data on a
server......... This then creates a new worksheet for each team and then
copies all the people in that team to the retrospective worksheet. it works
only to the point that if there is only one entry for the team that is does
not copy it and the worksheet remains blank.........

" wrote:

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