Create Worksheets
 

How do i change the script below to go through the list and have the
duplicates searched aswell but only
allow the name to be used once.

so that if there is

lead 1
lead 2
lead 3
lead 4
lead 4
lead 5
lead 6
lead 4

That it just makes the Worksheets
lead 1
lead 2
lead 3
lead 4
lead 5
lead 6


Sub SplitDump()

Dim sh As Worksheet, s As String
Dim i As Long, iloc as Long
Dim c As Range
Dim strAddress As String
Dim test As Integer

strMain = ActiveSheet.Name
i = 2
For Each c In Range("a1:a60")
strAddress = c.Address
If Len(c.Value) = 0 Then
MsgBox ("Finished")
Exit Sub
End If

If InStr(1, c.Value, "Lead:") Then
s = Trim(Right(c, Len(c) - 5))
iloc = Instr(1,s,"/",vbTextcompare)
if iloc < 0 then
s = Trim(Left(s,iloc-1))
end if
Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
sh.Name = s
i = 2
Else
c.Resize(1, 5).Copy sh.Cells(i, "A")
i = i + 1
End If
Next c

End Sub

Create Worksheets
 

Since you're adding sheets and renaming them immediately, you could just check
to see if that worksheet name already exists. If it does, just skip it.

This portion:
Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
sh.Name = s

Becomes:
set sh = nothing
on error resume next
set sh = sheets(s)
on error goto 0

'now check to see if that sheet didn't exist
if sh is nothing then
'it doesn't exist, so add it
Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
sh.Name = s
end if




Sjakkie wrote:

How do i change the script below to go through the list and have the
duplicates searched aswell but only
allow the name to be used once.

so that if there is

lead 1
lead 2
lead 3
lead 4
lead 4
lead 5
lead 6
lead 4

That it just makes the Worksheets
lead 1
lead 2
lead 3
lead 4
lead 5
lead 6

Sub SplitDump()

Dim sh As Worksheet, s As String
Dim i As Long, iloc as Long
Dim c As Range
Dim strAddress As String
Dim test As Integer

strMain = ActiveSheet.Name
i = 2
For Each c In Range("a1:a60")
strAddress = c.Address
If Len(c.Value) = 0 Then
MsgBox ("Finished")
Exit Sub
End If

If InStr(1, c.Value, "Lead:") Then
s = Trim(Right(c, Len(c) - 5))
iloc = Instr(1,s,"/",vbTextcompare)
if iloc < 0 then
s = Trim(Left(s,iloc-1))
end if
Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
sh.Name = s
i = 2
Else
c.Resize(1, 5).Copy sh.Cells(i, "A")
i = i + 1
End If
Next c

End Sub

--

Dave Peterson

Create Worksheets
 

worked an absolute treat. Thanks.

One last question. with the code below,

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

'now check to see if that sheet didn't exist
If sh Is Nothing Then
'it doesn't exist, so add it
Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
sh.Name = s
Else
c.Resize(1, 15).Copy sh.Cells(i, "D")
i = i + 1

Which is from the code earlier in the script.
I have another Data dump which i have an option in row d. however with the
above code i end up with only the data ranging from D Till the 15th column
after that. Is there a was where i can tell it to also take the column A, B
and C with this.....



"Dave Peterson" wrote:

Since you're adding sheets and renaming them immediately, you could just check
to see if that worksheet name already exists. If it does, just skip it.

This portion:
Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
sh.Name = s

Becomes:
set sh = nothing
on error resume next
set sh = sheets(s)
on error goto 0

'now check to see if that sheet didn't exist
if sh is nothing then
'it doesn't exist, so add it
Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
sh.Name = s
end if




Sjakkie wrote:

How do i change the script below to go through the list and have the
duplicates searched aswell but only
allow the name to be used once.

so that if there is

lead 1
lead 2
lead 3
lead 4
lead 4
lead 5
lead 6
lead 4

That it just makes the Worksheets
lead 1
lead 2
lead 3
lead 4
lead 5
lead 6

Sub SplitDump()

Dim sh As Worksheet, s As String
Dim i As Long, iloc as Long
Dim c As Range
Dim strAddress As String
Dim test As Integer

strMain = ActiveSheet.Name
i = 2
For Each c In Range("a1:a60")
strAddress = c.Address
If Len(c.Value) = 0 Then
MsgBox ("Finished")
Exit Sub
End If

If InStr(1, c.Value, "Lead:") Then
s = Trim(Right(c, Len(c) - 5))
iloc = Instr(1,s,"/",vbTextcompare)
if iloc < 0 then
s = Trim(Left(s,iloc-1))
end if
Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
sh.Name = s
i = 2
Else
c.Resize(1, 5).Copy sh.Cells(i, "A")
i = i + 1
End If
Next c

End Sub

--

Dave Peterson

Create Worksheets
 

Got it

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

"Sjakkie" wrote:

worked an absolute treat. Thanks.

One last question. with the code below,

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

'now check to see if that sheet didn't exist
If sh Is Nothing Then
'it doesn't exist, so add it
Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
sh.Name = s
Else
c.Resize(1, 15).Copy sh.Cells(i, "D")
i = i + 1

Which is from the code earlier in the script.
I have another Data dump which i have an option in row d. however with the
above code i end up with only the data ranging from D Till the 15th column
after that. Is there a was where i can tell it to also take the column A, B
and C with this.....



"Dave Peterson" wrote:

Since you're adding sheets and renaming them immediately, you could just check
to see if that worksheet name already exists. If it does, just skip it.

This portion:
Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
sh.Name = s

Becomes:
set sh = nothing
on error resume next
set sh = sheets(s)
on error goto 0

'now check to see if that sheet didn't exist
if sh is nothing then
'it doesn't exist, so add it
Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
sh.Name = s
end if




Sjakkie wrote:

How do i change the script below to go through the list and have the
duplicates searched aswell but only
allow the name to be used once.

so that if there is

lead 1
lead 2
lead 3
lead 4
lead 4
lead 5
lead 6
lead 4

That it just makes the Worksheets
lead 1
lead 2
lead 3
lead 4
lead 5
lead 6

Sub SplitDump()

Dim sh As Worksheet, s As String
Dim i As Long, iloc as Long
Dim c As Range
Dim strAddress As String
Dim test As Integer

strMain = ActiveSheet.Name
i = 2
For Each c In Range("a1:a60")
strAddress = c.Address
If Len(c.Value) = 0 Then
MsgBox ("Finished")
Exit Sub
End If

If InStr(1, c.Value, "Lead:") Then
s = Trim(Right(c, Len(c) - 5))
iloc = Instr(1,s,"/",vbTextcompare)
if iloc < 0 then
s = Trim(Left(s,iloc-1))
end if
Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
sh.Name = s
i = 2
Else
c.Resize(1, 5).Copy sh.Cells(i, "A")
i = i + 1
End If
Next c

End Sub

--

Dave Peterson