Looking for some help creating a macro that will sort through a list and
create a worksheet for each entry in a column. The data lists about 30-40
names mutiple times in several hundred entries. I need to create a new
worksheet titled with that persons name.

Thanks in advance! (Using Excel 2003)

Start here John
http://www.rondebruin.nl/copy5.htm

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"John" <(E-Mail Removed)> wrote in message news:305E20EE-B834-4E7A-A008-(E-Mail Removed)...
> Looking for some help creating a macro that will sort through a list and
> create a worksheet for each entry in a column. The data lists about 30-40
> names mutiple times in several hundred entries. I need to create a new
> worksheet titled with that persons name.
>
> Thanks in advance! (Using Excel 2003)

Hello, this will do it if you data is in column A

Sub sheets()
Dim LRow As Long
LRow = ActiveSheet.Range("A65536").End(xlUp).Row
Dim cell As Range
For Each cell In Range("A1:A" & LRow)
If cell.Value > "" Then
Worksheets.Add().Name = cell.Value
End If
Next cell
End Sub

GTVT06 - won't that create a new worksheet for every cell in column A,
even if it a worksheet has been created for that value? He could end
up with thousands!


On Jul 30, 5:39*pm, GTVT06 <gtv...@hotmail.com> wrote:
> Hello, this will do it if you data is in column A
>
> Sub sheets()
> Dim LRow As Long
> * * LRow = ActiveSheet.Range("A65536").End(xlUp).Row
> Dim cell As Range
> * * For Each cell In Range("A1:A" & LRow)
> * * * * If cell.Value > "" Then
> * * * * Worksheets.Add().Name = cell.Value
> * * * * End If
> * * Next cell
> End Sub

Sub Sheets()
Dim Rng as Range
Dim WS1 as Worksheet
Dim WS2 as Worksheet
Dim LRow As Long


Set WS1 = ActiveSheet
Set WS2 = Worksheets.Add
Set Rng = WS1.Range("A1:YOUR LAST COLUMN OF DATA" & Rows.Count)

' Creates list of unique values
With WS2
Rng.Columns(FieldNum).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("A1"), Unique:=True

' Creates worksheets from unique values
LRow = WS2.Range("A65536").End(xlUp).Row
Dim cell As Range
For Each cell In Range("A1:A" & LRow)
If cell.Value > "" Then
Worksheets.Add().Name = cell.Value
End If
Next cell
End Sub




On Jul 30, 5:58*pm, sbit...@gmail.com wrote:
> GTVT06 - won't that create a new worksheet for every cell in column A,
> even if it a worksheet has been created for that value? He could end
> up with thousands!
>
> On Jul 30, 5:39*pm, GTVT06 <gtv...@hotmail.com> wrote:
>
> > Hello, this will do it if you data is in column A
>
> > Sub sheets()
> > Dim LRow As Long
> > * * LRow = ActiveSheet.Range("A65536").End(xlUp).Row
> > Dim cell As Range
> > * * For Each cell In Range("A1:A" & LRow)
> > * * * * If cell.Value > "" Then
> > * * * * Worksheets.Add().Name = cell.Value
> > * * * * End If
> > * * Next cell
> > End Sub

On Jul 30, 4:58*pm, sbit...@gmail.com wrote:
> GTVT06 - won't that create a new worksheet for every cell in column A,
> even if it a worksheet has been created for that value? He could end
> up with thousands!
>
> On Jul 30, 5:39*pm, GTVT06 <gtv...@hotmail.com> wrote:
>
>
>
> > Hello, this will do it if you data is in column A
>
> > Sub sheets()
> > Dim LRow As Long
> > * * LRow = ActiveSheet.Range("A65536").End(xlUp).Row
> > Dim cell As Range
> > * * For Each cell In Range("A1:A" & LRow)
> > * * * * If cell.Value > "" Then
> > * * * * Worksheets.Add().Name = cell.Value
> > * * * * End If
> > * * Next cell
> > End Sub- Hide quoted text -
>
> - Show quoted text -

your right, I forgot he said he would have them listed multiple times,
I wrote that expecting there were no duplicates.

No problem, I borrowed your code to finish it, however I forgot to
delete the filter sheet.

John, if you're still looking, add this line at the end

WS2.Delete

On Jul 30, 7:59*pm, GTVT06 <gtv...@hotmail.com> wrote:
> On Jul 30, 4:58*pm, sbit...@gmail.com wrote:
>
>
>
> > GTVT06 - won't that create a new worksheet for every cell in column A,
> > even if it a worksheet has been created for that value? He could end
> > up with thousands!
>
> > On Jul 30, 5:39*pm, GTVT06 <gtv...@hotmail.com> wrote:
>
> > > Hello, this will do it if you data is in column A
>
> > > Sub sheets()
> > > Dim LRow As Long
> > > * * LRow = ActiveSheet.Range("A65536").End(xlUp).Row
> > > Dim cell As Range
> > > * * For Each cell In Range("A1:A" & LRow)
> > > * * * * If cell.Value > "" Then
> > > * * * * Worksheets.Add().Name = cell.Value
> > > * * * * End If
> > > * * Next cell
> > > End Sub- Hide quoted text -
>
> > - Show quoted text -
>
> your right, I forgot he said he would have them listed multiple times,
> I wrote that expecting there were no duplicates.

Thanks Ron...this worked perfectly!

"Ron de Bruin" wrote:

> Start here John
> http://www.rondebruin.nl/copy5.htm
>
> --
>
> Regards Ron de Bruin
> http://www.rondebruin.nl/tips.htm
>
>
> "John" <(E-Mail Removed)> wrote in message news:305E20EE-B834-4E7A-A008-(E-Mail Removed)...
> > Looking for some help creating a macro that will sort through a list and
> > create a worksheet for each entry in a column. The data lists about 30-40
> > names mutiple times in several hundred entries. I need to create a new
> > worksheet titled with that persons name.
> >
> > Thanks in advance! (Using Excel 2003)
>