creating unique new worksheets
 

I have a large list of data from a database, and need to turn that into
worksheets in a larger VBA macro (as there are many other things that I
need to do with it in the future).

It consists of a person's name, and then many pieces of data
afterwards. The data also comes out by week, so names are often
repeated. something like this:


NAME Var1 Var2 Var3 etc week number

Person1 data data data 10
Person2 data data data 10
Person3 data data data 10
Person1 data data data 9
Person2 data data data 9
Person3 data data data 9
Person1 data data data 8
etc...

I would like to be able to make a new worksheet for each person in the
overall list, and copy all of their data over to their new worksheet,
in an arbitrary cell number.

Thanks in advance.


---
Message posted from http://www.ExcelForum.com/

creating unique new worksheets
 

Sub test()
Const cPersonName = 1, cVar1 = 2, cVar2 = 3, cVar3 = 4, cWeek = 5
Dim wksS As Worksheet, wks As Worksheet, i As Long, j As Long,
lngLastRow As Long

Set wksS = Worksheets("Main Data")
lngLastRow = wksS.Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To lngLastRow
On Error Resume Next
Set wks = Worksheets(wksS.Cells(i, cPersonName).Value)
If Err.Number Then
Set wks = Worksheets.Add(after:=Worksheets(Worksheets.Count) )
wks.Name = wksS.Cells(i, cPersonName).Value
wks.Cells(1, cPersonName) = "Person Name"
wks.Cells(1, cVar1) = "Var1"
wks.Cells(1, cVar2) = "Var2"
wks.Cells(1, cVar3) = "Var3"
wks.Cells(1, cWeek) = "Week"
Err.Clear
End If
On Error GoTo 0

j = wks.Cells(Rows.Count, 1).End(xlUp).Row + 1
wks.Cells(j, cPersonName) = wksS.Cells(i, cPersonName)
wks.Cells(j, cVar1) = wksS.Cells(i, cVar1)
wks.Cells(j, cVar2) = wksS.Cells(i, cVar2)
wks.Cells(j, cVar3) = wksS.Cells(i, cVar2)
wks.Cells(j, cWeek) = wksS.Cells(i, cWeek)
Next
End Sub


--
Rob van Gelder - http://www.vangelder.co.nz/excel


"stuph " wrote in message
...
I have a large list of data from a database, and need to turn that into
worksheets in a larger VBA macro (as there are many other things that I
need to do with it in the future).

It consists of a person's name, and then many pieces of data
afterwards. The data also comes out by week, so names are often
repeated. something like this:


NAME Var1 Var2 Var3 etc week number

Person1 data data data 10
Person2 data data data 10
Person3 data data data 10
Person1 data data data 9
Person2 data data data 9
Person3 data data data 9
Person1 data data data 8
etc...

I would like to be able to make a new worksheet for each person in the
overall list, and copy all of their data over to their new worksheet,
in an arbitrary cell number.

Thanks in advance.


---
Message posted from http://www.ExcelForum.com/

creating unique new worksheets
 

Wow! Thanks for such a quick and useful response... after editing thi
a bit, it will do exactly what i need.. thanks again..

Rob van Gelder wrote:
[b]Sub test()
Const cPersonName = 1, cVar1 = 2, cVar2 = 3, cVar3 = 4, cWeek = 5
Dim wksS As Worksheet, wks As Worksheet, i As Long, j As Long,
lngLastRow As Long

Set wksS = Worksheets("Main Data")
lngLastRow = wksS.Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To lngLastRow
On Error Resume Next
Set wks = Worksheets(wksS.Cells(i, cPersonName).Value)
If Err.Number Then
Set wks = Worksheets.Add(after:=Worksheets(Worksheets.Count) )
wks.Name = wksS.Cells(i, cPersonName).Value
wks.Cells(1, cPersonName) = "Person Name"
wks.Cells(1, cVar1) = "Var1"
wks.Cells(1, cVar2) = "Var2"
wks.Cells(1, cVar3) = "Var3"
wks.Cells(1, cWeek) = "Week"
Err.Clear
End If
On Error GoTo 0

j = wks.Cells(Rows.Count, 1).End(xlUp).Row + 1
wks.Cells(j, cPersonName) = wksS.Cells(i, cPersonName)
wks.Cells(j, cVar1) = wksS.Cells(i, cVar1)
wks.Cells(j, cVar2) = wksS.Cells(i, cVar2)
wks.Cells(j, cVar3) = wksS.Cells(i, cVar2)
wks.Cells(j, cWeek) = wksS.Cells(i, cWeek)
Next
End Sub


--
Rob van Gelder - http://www.vangelder.co.nz/exce

--
Message posted from http://www.ExcelForum.com