How can i look though the list and ignore any duplicates for the worksheet
lead names with the below code.


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

Sjakkie,

Something like

Dim c As Range
For Each c In Range("a1:a60")
If Application.CountIf(Range("A1", c), c.Value) = 1 Then
MsgBox "Hello, I'm processing " & c.Value
'Rest of your code
End If
Next c


HTH,
Bernie
MS Excel MVP



"Sjakkie" wrote in message
...
How can i look though the list and ignore any duplicates for the worksheet
lead names with the below code.


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

That does not seem to work sorry.

"Bernie Deitrick" wrote:

Sjakkie,

Something like

Dim c As Range
For Each c In Range("a1:a60")
If Application.CountIf(Range("A1", c), c.Value) = 1 Then
MsgBox "Hello, I'm processing " & c.Value
'Rest of your code
End If
Next c


HTH,
Bernie
MS Excel MVP



"Sjakkie" wrote in message
...
How can i look though the list and ignore any duplicates for the worksheet
lead names with the below code.


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

Is this right or should i have that code else where?


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
Dim j As Range

For Each j In Range("a1:a60")
If Application.CountIf(Range("A1", j), j.Value) = 1 Then
MsgBox "Hello, I'm processing " & j.Value
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 If
Next j


"Bernie Deitrick" wrote:

Sjakkie,

Something like

Dim c As Range
For Each c In Range("a1:a60")
If Application.CountIf(Range("A1", c), c.Value) = 1 Then
MsgBox "Hello, I'm processing " & c.Value
'Rest of your code
End If
Next c


HTH,
Bernie
MS Excel MVP



"Sjakkie" wrote in message
...
How can i look though the list and ignore any duplicates for the worksheet
lead names with the below code.


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

After checking the code i noticed that it searches all the entiers for only
ones that are not duplicate. I want 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




"Sjakkie" wrote:

How can i look though the list and ignore any duplicates for the worksheet
lead names with the below code.


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

If they are true duplicates, i.e. complete record is identical, then why not
delete them?

"Sjakkie" wrote:

How can i look though the list and ignore any duplicates for the worksheet
lead names with the below code.


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

as the data dump needs to remain intackt.

"JLGWhiz" wrote:

If they are true duplicates, i.e. complete record is identical, then why not
delete them?

"Sjakkie" wrote:

How can i look though the list and ignore any duplicates for the worksheet
lead names with the below code.


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