VBA Guys: Help with Excel Macro

[Ignoramus 5,794]

The extent of my macro-writing ability comes from cobbling together recorded macros and google search results so I'm running into a wall.

I have a worksheet named "LOCATIONS" that can have a variable number of unique location names (one week there may be ten locations on the list, the next week twenty different ones). Example:

0142 - DENVER

0687 - HOUSTON

1374 - DALLAS

655A - NEW ORLEANS

8743 - SAN DIEGO

Etc...

I need a macro that will step through the list and for each location name, create a new worksheet and name that sheet for the location.

[Titans_fan 118]

Do you want a new sheet every week regardless of if you have one already? Per your example, if you have that list this week and next week contains Denver and New Orleans but adds Detroit and Cleveland, do you just want Detroit and Cleveland or all four...

[Ignoramus 5,794]

Do you want a new sheet every week regardless of if you have one already? Per your example, if you have that list this week and next week contains Denver and New Orleans but adds Detroit and Cleveland, do you just want Detroit and Cleveland or all four...

There will be a completely new data file each week (not appended or anything). The spreadsheet should contain only sheets for locations that have entries that week.

[Thorpe 218]

Copy this into the workbook code module. The sheet with the names should be sheet 1, column 1

Sub MakeNewSheets()

Dim i As Long, sht As Worksheet

'200 is an arbitrarily large number

For i = 200 To 1 Step -1 ' go in reverse to make spreadsheets order correctly

If Trim(Sheet1.Cells(i, 1)) <> "" Then 'only make a sheet if there is a value

Set sht = ThisWorkbook.Worksheets.Add 'add the sheet

sht.Name = Sheet1.Cells(i, 1) 'rename it

End If

Next

End Sub

[Ignoramus 5,794]

Copy this into the workbook code module. The sheet with the names should be sheet 1, column 1

Sub MakeNewSheets()

Dim i As Long, sht As Worksheet

'200 is an arbitrarily large number

For i = 200 To 1 Step -1 ' go in reverse to make spreadsheets order correctly

If Trim(Sheet1.Cells(i, 1)) <> "" Then 'only make a sheet if there is a value

Set sht = ThisWorkbook.Worksheets.Add 'add the sheet

sht.Name = Sheet1.Cells(i, 1) 'rename it

End If

Next

End Sub

Appreciate the help, but something's not quite right.

The workbook has one sheet named Sheet1 and the locations are listed in column A. When I run the macro, there are no new sheets created -- in fact, there's no "feedback" at all. I ran some other macros just to make sure I wasn't screwing something up there and they run. It's Office 2010, if that makes any difference.

[BroadwayG 948]

Sub Test()
Dim i As Long

i = 1

Do Until Trim(Sheets(1).Cells(i, 1)) = ""
Sheets.Add After:=Sheets(Sheets.Count)

Sheets(Sheets.Count).Name = Sheets(1).Cells(i, 1)

i = i + 1

Loop
End Sub

[Ignoramus 5,794]

Sub Test()

Dim i As Long

i = 1

Do Until Trim(Sheets(1).Cells(i, 1)) = ""

Sheets.Add After:=Sheets(Sheets.Count)

Sheets(Sheets.Count).Name = Sheets(1).Cells(i, 1)

i = i + 1

Loop

End Sub

Perfect! Thanks.

[Ignoramus 5,794]

OK, I've added some to your code, BroadwayG. I'm sure it's ugly as sin, but I've gotten it to do just about everything I need it to do with one exception: my data and sheet names are off by one.

Example:

Sheet Named 0142 - DENVER is blank

Sheet Named 0687 - HOUSTON - has Denver data

Sheet Named 1374 - DALLAS - has Houston data

Sheet Named 655A - NEW ORLEANS - has Dallas data

Sheet Named 8743 - SAN DIEGO - has New Orleans data

I'm close but not smart enough to know what I'm missing. Would appreciate some help!

Here's what I came up with:

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Dim i As Long, branch As String

i = 1

Do Until Trim(Sheets(2).Cells(i, 1)) = ""

Sheets("Data").Select

ActiveSheet.Range("$A$1:$U$9999").AutoFilter Field:=1, Criteria1:= _

branch ' Applies an autofilter to search for the location name

ActiveCell.SpecialCells(xlLastCell).Select ' Selects and copies all filtered data

Range(Selection, Cells(1)).Select

Selection.Copy

Sheets.Add After:=Sheets(Sheets.Count)

Sheets(Sheets.Count).Name = Sheets(2).Cells(i, 1)

branch = Sheets(2).Cells(i, 1)

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

i = i + 1

Loop

[Ignoramus 5,794]

Solved it!

I moved the line branch = Sheets(2).Cells(i, 1) up and that took care of it.

[BroadwayG 948]

Excellent.