Split a datadump and create new worksheets.

[Sjakkie]

I have a data dump which consist of Leads and helpers in column A and
different data for each of the helpers in column B, C, D and E.
I am trying to make a new sheet per Lead But it sems to make for every on in
Column A, How can i get this to only take the Leads who have "Lead:" before
their name.

The script i am using is as follows.

Sub SplitDump()

Dim strMain As String
Dim strAddress As String
Dim test As Integer

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

test = InStr(1, c.Value, "Lead:")

Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value
strSubAddr = "'" & c.Value & "'!A1"
Sheets(strMain).Select
Next c

End Sub

I there a way where i can loop though to say creat a new worksheet for lead
1 and add all the helpers and their respective data in B,C,D and E and then
go to the next lead.

The table looks something like this....
A b c d
Lead: -1
Helper: 1-1 data 1-1-1 data 1-2-1 data 1-3-1
Helper: 1-2 data 1-1-2 data 1-2-2 data 1-3-2
Helper: 1-3 data 1-1-3 data 1-2-3 data 1-3-3
Helper: 1-4 data 1-1-4 data 1-2-4 data 1-3-4
Helper: 1-5 data 1-1-5 data 1-2-5 data 1-3-5
Helper: 1-6 data 1-1-6 data 1-2-6 data 1-3-6
Helper: 1-7 data 1-1-7 data 1-2-7 data 1-3-7
Helper: 1-8 data 1-1-8 data 1-2-8 data 1-3-8
Helper: 1-9 data 1-1-9 data 1-2-9 data 1-3-9
Helper: 1-10 data 1-1-10 data 1-2-10 data 1-3-10
Lead: -2
Helper: 2-1 data 2-1-1 data 2-2-1 data 2-3-1
Helper: 2-2 data 2-1-2 data 2-2-2 data 2-3-2
Helper: 2-3 data 2-1-3 data 2-2-3 data 2-3-3
Helper: 2-4 data 2-1-4 data 2-2-4 data 2-3-4
Helper: 2-5 data 2-1-5 data 2-2-5 data 2-3-5
Helper: 2-6 data 2-1-6 data 2-2-6 data 2-3-6
Helper: 2-7 data 2-1-7 data 2-2-7 data 2-3-7
Helper: 2-8 data 2-1-8 data 2-2-8 data 2-3-8
Helper: 2-9 data 2-1-9 data 2-2-9 data 2-3-9
Helper: 2-10 data 2-1-10 data 2-2-10 data 2-3-10
Lead: -3
Helper: 3-1 data 3-1-1 data 3-2-1 data 3-3-1
Helper: 3-2 data 3-1-2 data 3-2-2 data 3-3-2
Helper: 3-3 data 3-1-3 data 3-2-3 data 3-3-3
Helper: 3-4 data 3-1-4 data 3-2-4 data 3-3-4
Helper: 3-5 data 3-1-5 data 3-2-5 data 3-3-5
Helper: 3-6 data 3-1-6 data 3-2-6 data 3-3-6
Helper: 3-7 data 3-1-7 data 3-2-7 data 3-3-7
Helper: 3-8 data 3-1-8 data 3-2-8 data 3-3-8
Helper: 3-9 data 3-1-9 data 3-2-9 data 3-3-9
Helper: 3-10 data 3-1-10 data 3-2-10 data 3-3-10


Please help

 

[Tom Ogilvy]

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

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))
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]

Thanks A million
sorry forgot to note that the "lead:" contain is as follows.

"Lead: name / Telephone"
How can i remove the "/ telephone" from this. Without the "/" It works Great.

 

[Tom Ogilvy]

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

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)
s = Trim(Left(s,iloc-1))
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

 

[Tom Ogilvy]

In case the / character doesn't exits in some cases:

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