On Friday, May 10, 2013 7:45:37 AM UTC-7, wrote:
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

Hi RBS,

I need some school-housin' on what I do to use it.

Howard