Loop to Filter, Name Sheets. If Blank, Exit Loop

R

ryguy7272

The macro below fails on this line:
mySht.Name = myCell.Value
If and only if, filtering is done on a certain column and there is a blank
cell in that column, or some character which is not permitted in a sheet
name, such as ? How can I trap this error and continue, or just exit the
macro. I tried a few things; nothing worked.

Sub ExportDatabaseToSeparateSheets()
'Export is based on the value in the desired column
Dim myCell As Range
Dim mySht As Worksheet
Dim myName As String
Dim myArea As Range
Dim myShtName As String
Dim KeyCol As Integer

myShtName = ActiveSheet.Name
KeyCol = InputBox("What column # within database to use as key?")
Set myArea = ActiveCell.CurrentRegion.Columns(KeyCol).Offset(1, 0).Cells
Set myArea = myArea.Resize(myArea.Rows.Count - 1, 1)
For Each myCell In myArea
On Error GoTo NoSheet
myName = Worksheets(myCell.Value).Name
GoTo SheetExists:
NoSheet:
Set mySht = Worksheets.Add(Before:=Worksheets(1))
mySht.Name = myCell.Value ' < -- problem occurs here!!
With myCell.CurrentRegion
.AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell
End Sub

Regards,
Ryan--
 
D

Dave Peterson

I'd use:

Set mySht = Worksheets.Add(Before:=Worksheets(1))
on error resume next
mySht.Name = myCell.Value ' < -- problem occurs here!!
if err.number <> 0 then
msgbox mySht & " wasn't renamed"
err.clear
end if
on error goto 0

But I think you're going to have trouble earlier in the code, too. If the value
in mycell is invalid (or empty), you'll get an error when you do:
On Error GoTo NoSheet
myName = Worksheets(myCell.Value).Name
GoTo SheetExists:

You'll go to the SheetExists error processing section.

I'm not sure what you're doing with the top portion of your code, but you could
use a function (from Chip Pearson) to test the existence of a sheet.

Function WorksheetExists(SheetName As Variant, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
WorksheetExists = CBool(Len(WB.Worksheets(SheetName).Name) > 0)
End Function

'and you can use it like:
....
if worksheetexists("myname",activeworkbook) then
 
R

ryguy7272

Still getting an error here. I'm working on an alternative method right now.
Thanks for trying Dave.

Regards,
Ryan--
 
D

Dave Peterson

You may want to post the code that fails.
Still getting an error here. I'm working on an alternative method right now.
Thanks for trying Dave.

Regards,
Ryan--
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top