ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Trying to generate mutiple list for one (https://www.excelbanter.com/excel-programming/278667-trying-generate-mutiple-list-one.html)

ROn

Trying to generate mutiple list for one
 
This is a repeat question. Im want to be able to make a
list of names. In the spreadsheet i want to list
Name/DOB/City. Is there anyway to automate(macro?) the
list to organize themselves into seperate worksheets
based upon the city the names are in?

I just dont want to have to search thru names and do alot
of cut and pasting to seperate them

Thank You all

Chris Putzig

Trying to generate mutiple list for one
 
Try this:

Sub moveToCitySheet()

Dim startSheet As Worksheet
Dim mySheet As Worksheet
Dim columnCity As Integer
Dim lastDataColumn As Integer
Dim firstRowOfData As Integer
Dim i As Integer
Dim j As Integer
Dim sheetExists As Boolean
Dim alreadyHeardThis As Boolean
Dim currentRow As Integer
Set startSheet = ActiveSheet
columnCity = 3 'change if you want another column to create sheets
lastDataColumn = 3 'change if you want more than 3 columns of data
firstRowOfData = 2
i = firstRowOfData 'first row with data
'delete any existing sheet with city name, i.e. last run
alreadyHeardThis = False
While startSheet.Cells(i, 1) < "" 'Loop until row (i) column 1 is blank
For Each mySheet In ActiveWorkbook.Sheets
If CStr(startSheet.Cells(i, columnCity).Value) = mySheet.Name
Then
If startSheet.Name = mySheet.Name Then
If Not alreadyHeardThis Then MsgBox "Can't Delete the
start sheet and will not populate it"
alreadyHeardThis = True
Exit For
Else
Application.DisplayAlerts = False
mySheet.Delete
Application.DisplayAlerts = True
Exit For
End If
End If
Next
i = i + 1
Wend
i = firstRowOfData
'Now create sheets
While startSheet.Cells(i, 1) < ""
sheetExists = False
For Each mySheet In ActiveWorkbook.Sheets 'check to see if already
created
If CStr(startSheet.Cells(i, columnCity).Value) = mySheet.Name
Then
sheetExists = True
Exit For
End If
Next
If Not sheetExists Then
Sheets.Add.Name = CStr(startSheet.Cells(i, columnCity).Value)
For j = 1 To lastDataColumn 'Add Headers
Cells(1, j) = startSheet.Cells(1, j)
Cells(2, 1).Select 'get it ready to populate
Next
End If
i = i + 1
Wend
'Now populate the sheets
i = firstRowOfData
While startSheet.Cells(i, 1) < ""
If Not startSheet.Name = CStr(startSheet.Cells(i,
columnCity).Value) Then
Sheets(CStr(startSheet.Cells(i, columnCity).Value)).Select
currentRow = ActiveCell.Row
For j = 1 To lastDataColumn 'Add Headers
Cells(currentRow, j) = startSheet.Cells(i, j)
Cells(currentRow, j).NumberFormat = startSheet.Cells(i,
j).NumberFormat
Cells(currentRow + 1, 1).Select 'get it ready to
populate next
Next
End If
i = i + 1
Wend

End Sub


"ROn" wrote in message
...
This is a repeat question. Im want to be able to make a
list of names. In the spreadsheet i want to list
Name/DOB/City. Is there anyway to automate(macro?) the
list to organize themselves into seperate worksheets
based upon the city the names are in?

I just dont want to have to search thru names and do alot
of cut and pasting to seperate them

Thank You all





All times are GMT +1. The time now is 05:59 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com