Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Creating new worksheets from a single list 1

Status
Not open for further replies.

SirWaldizmo

Programmer
Mar 4, 2002
9
US
Hi,

I have a list of states, cities within the state, and counts of patrons in each city in one long list. I'd like to know if theres a way to create a new worksheet for each state?

thanks
 
this macro will do what you want, it assumes that the states are in column 1 after each other with no blanks.
Note: you will have to change sheet1 to the name where the data is

Sub insert()

With ThisWorkbook.Worksheets("Sheet1")
i = .UsedRange.Rows.Count

For r = 2 To i
strname = .Cells(r, 1).Value
Sheets.Add.Name = strname

Next
End With
End Sub
 
Hey Ramzisaab...

I've tried that code ... and i see where it is going .. but i have a problem.. for each state is listed multiple times... eg..

California Los Angeles 12
California San Francisco 35
California San Diego 50
Florida Orlando 30
Florida Miami 20

so... i would need to grab the group of california cities and create a worksheet out of it. Is that possible with your code?

thanks for the reply.
 
could u tell me if the data is in the same column or seperate columns

if all the states are in one column and all the cities are in another...then it shouldnt be not to hard to be to change the code!
 
Yes... they are in seperate columns.

state, city, count

thanks!
 
Ramzisaab, please excuse me for cuttint in, but I think this is what SirWaldizmo is looking for:
[blue]
Code:
Option Explicit

Sub CreateStateTabs()
Dim oStates As Collection
Dim c As Range
Dim i As Integer
  Set oStates = New Collection
  For Each c In Intersect(ActiveSheet.UsedRange, Range("A:A"))
    On Error Resume Next
    oStates.Add c.Value, c.Value
  Next c
  On Error GoTo 0
  For i = 1 To oStates.Count
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name _
             = oStates.Item(i)
  Next i
  Set oStates = Nothing
End Sub
[/color]

Note that it is not necessary to have the data sorted by state (unless you want to).
 
here is my version a bit crude but it does the job :)
Sub insert()

With ThisWorkbook.Worksheets("Sheet1")
i = .UsedRange.Rows.Count

For r = 2 To i
strcount = 0
strname = .Cells(r, 1).Value
For Each ws In ThisWorkbook.Worksheets
If ws.Name = strname Then
strcount = q + 1
End If
Next ws

If strcount = 0 Then
Sheets.Add.Name = strname
End If

Next
End With
End Sub
 
I'm sorry guys... i am close ... but still need some help on the codes.

Zathras...

Your code ran and created the new sheets but it did not populate the sheets with the data.

Ramzi...
I changed the 'sheet1' from your code to the name of my sheet with the data and got a vb error on line 2: Variable not defined. and 'i=' is highlighted in grey.

appreciate your help guys
 
You didn't actually say you wanted to copy the data, just create the sheets [smile]

Try this:
[blue]
Code:
Option Explicit

Sub CreateStateTabs()
Dim oStates As Collection
Dim c As Range
Dim i As Integer
Dim sActiveSheet As String
  sActiveSheet = ActiveSheet.Name
  Set oStates = New Collection
  For Each c In Intersect(ActiveSheet.UsedRange, Range("A:A"))
    If c.Row > 1 Then
      On Error Resume Next
      oStates.Add c.Value, c.Value
    End If
  Next c
  On Error GoTo 0
  For i = 1 To oStates.Count
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name _
             = oStates.Item(i)
  Next i
  Set oStates = Nothing
  CopyDataToStateTabs sActiveSheet
End Sub

Sub CopyDataToStateTabs(SourceSheet As String)
Dim sht As Worksheet

  With Worksheets(SourceSheet)
    .Activate
    Range("A1").Select
    Selection.AutoFilter
    ActiveSheet.UsedRange.Select
    For Each sht In Worksheets
      If sht.Name <> SourceSheet Then
        Selection.AutoFilter Field:=1, Criteria1:=sht.Name
        Selection.Copy
        sht.Range(&quot;A1&quot;).PasteSpecial xlPasteAll
      End If
    Next sht
    .Select
  End With
  Application.CutCopyMode = False
  Selection.AutoFilter
  Range(&quot;A1&quot;).Select
End Sub
[/color]

Note that I have assumed there are column headings in row 1. If not, you need to put them in before this will work.
 
Surely this is a case for utilising built in functionality
Whap a pivot table over your data

State as page field
City as row field
SUM of COUNT as value field

Then, in the pivot table toolbar, there should be a drop down list available - choose &quot;Show Pages&quot; from that
I think you'll be pleasantly surprised

Rgds, Geoff
Quantum materiae materietur marmota monax si marmota monax materiam possit materiari?
Want the best answers to your questions ? faq222-2244
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top