You may find this code useful:


Function AddSheet(ByVal strSheet As String, _
ByVal bOverwrite As Boolean, _
ByVal lLocation As Long, _
Optional ByVal bClear As Boolean = True, _
Optional ByVal bActivate As Boolean = True, _
Optional bSetScreenUpdating As Boolean = True, _
Optional strCallingProc As String) As String

'strSheet, name of the new sheet
'bOverWrite, clear existing sheet and don't use new sheet if TRUE
'lLocation,
'1 new sheet will be first one in the WB
'2 new sheet will be before active sheet
'3 new sheet will be after active sheet
'4 new sheet will be last one in the WB
'if bClear = True it will clear the cells of an existing sheet
'will return the name of the newly added sheet
'-----------------------------------------------------------------

Dim i As Long
Dim bFound As Boolean
Dim objNewSheet As Worksheet
Dim objSheet As Worksheet
Dim strOldSheet As String
Dim strSuppliedSheetName As String
Dim lLastNumber As Long

AGAIN:

10 On Error GoTo ERROROUT

20 If bSetScreenUpdating Then
30 Application.ScreenUpdating = False
40 End If

50 HaveOpenActiveWorkbook

60 strSheet = ClearCharsFromString(strSheet, "*:?/\[]")

70 If bActivate = False Then
80 strOldSheet = ActiveSheet.Name
90 End If

100 strSuppliedSheetName = strSheet

'see if the sheet already exists
'-------------------------------
110 For i = 1 To ActiveWorkbook.Sheets.Count
120 If UCase(Sheets(i).Name) = UCase(strSheet) Then
130 bFound = True
140 If bOverwrite Then
'no new sheet to add
'-------------------
150 Sheets(i).Activate
'otherwise there will be an error at the line
'Cells.Clear when a chart is activated
'--------------------------------------------
160 Sheets(i).Cells(1).Activate
170 If bClear Then
180 Cells.Clear
190 End If
200 AddSheet = strSheet
210 If bActivate = False Then
220 Sheets(strOldSheet).Activate
230 End If
240 If bSetScreenUpdating Then
250 Application.ScreenUpdating = True
260 End If
270 Exit Function
280 End If
290 End If
300 Next i

310 For Each objSheet In ActiveWorkbook.Worksheets
320 If objSheet.Name = strSheet Then
330 bFound = True
340 Exit For
350 End If
360 Next objSheet

'sheet not in WB yet, or bOverWrite = FALSE, so add
'--------------------------------------------------
370 Select Case lLocation
Case 1
380 Set objNewSheet =
ActiveWorkbook.Sheets.Add(Befo=ActiveWorkbook.S heets(1))
390 Case 2
400 Set objNewSheet = ActiveWorkbook.Sheets.Add 'will be
before active sheet
410 Case 3
420 Set objNewSheet = ActiveWorkbook.Sheets.Add(After:=ActiveSheet)
430 Case 4
440 Set objNewSheet =
ActiveWorkbook.Sheets.Add(After:=Sheets(ActiveWork book.Sheets.Count))
450 End Select

'activate and name it
'--------------------
460 objNewSheet.Activate

'truncate if sheet name is too long
'----------------------------------
470 If Len(strSheet) 27 Then
480 strSheet = Left$(strSheet, 27) & "_" & 1
490 i = 1
500 Do While SheetExists(Left$(strSheet, 27) & "_" & i) = True
510 i = i + 1
520 strSheet = Left$(strSheet, 27) & "_" & i
530 Loop
540 End If

550 If bFound = False Then
560 ActiveSheet.Name = strSheet
570 AddSheet = strSheet
580 Else
590 If StringEndsUnderScoreNumber(strSheet) Then
600 Do While SheetExists(strSheet) = True
610 lLastNumber = Val(GetLastNumberFromString(strSheet, "."))
620 strSheet = Left$(strSheet, Len(strSheet) -
Len(CStr(lLastNumber))) & _
lLastNumber + 1
630 Loop
640 ActiveSheet.Name = strSheet
650 AddSheet = strSheet
660 Else
670 i = 2
680 Do Until SheetExists(strSheet & "_" & i) = False
690 i = i + 1
700 Loop
710 ActiveSheet.Name = strSheet & "_" & i
720 AddSheet = strSheet & "_" & i
730 End If
740 End If

750 If bActivate = False Then
760 Sheets(strOldSheet).Activate
770 End If

780 If bSetScreenUpdating Then
790 Application.ScreenUpdating = True
800 End If

810 Exit Function
ERROROUT:

'this is needed for in case for example the workbook was protected
'-----------------------------------------------------------------
820 If Err.Number = 1004 Then
830 Application.Workbooks.Add
840 GoTo AGAIN
850 End If

860 If bSetScreenUpdating Then
870 Application.ScreenUpdating = True
880 End If

890 WriteErrorLog "Functions1", "AddSheet", Erl, Err, , True

End Function


Function SheetExists(ByVal strSheetName As String) As Boolean
On Error Resume Next
SheetExists = Len(ActiveWorkbook.Sheets(strSheetName).Name)
End Function


Function HaveOpenActiveWorkbook() As Boolean

'-------------------------------------------------
'check for an active open WB (Personal.xls is not)
'and add a workbook if there was none
'will return True if a WB was added
'-------------------------------------------------
Dim strWB As String
Dim dLeftMargin As Double

On Error GoTo ERROROUT

If Application.Workbooks.Count 1 Then
'or could there be a situation where there is more than one
'workbook and both are not an ActiveWorkbook ??!
'----------------------------------------------------------
Exit Function
End If

If Application.Workbooks.Count = 0 Then
Application.Workbooks.Add
HaveOpenActiveWorkbook = True
Exit Function
End If

'so now we know we have one WB open and need to check if this is
'Personal.xls as in that case we need to add a normal workbook
'----------------------------------------------------------------

'this will give an error if only Personal.xls is open
'----------------------------------------------------
strWB = ActiveWorkbook.Name

'no error, so it was a normal workbook and nil to be done
'--------------------------------------------------------

On Error GoTo ERROROUT2
dLeftMargin = ActiveSheet.PageSetup.LeftMargin
bCanDoPageSetupLeftMargin = True

Exit Function
ERROROUT:

Application.Workbooks.Add
HaveOpenActiveWorkbook = True

ERROROUT2:

End Function


RBS


"Howard" wrote in message
...

With a list of names in column A, this code will add a sheet and name it
from that list.

If I add a few names to the list, how can I ignore the names with sheets
already named from the list and add sheets for the new names?
And keep the entire list intact.

Thanks,
Howard

Option Explicit
Sub SheetsAhoy()
Dim MySnme As Range
Dim c As Range
Set MySnme = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
For Each c In MySnme
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value
Next
End Sub