Create Worksheets

[Guest]

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]

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

 

[Guest]

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.....

 

[Guest]

Got it

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