Excel VBA won't copy Worksheets after sheet Deletion

T

tagar

So, I've written some code that reads through a list of sheets, and in
the event a given sheet can NOT be found in the workbook, the code
copies a "Template" sheet and names it after the missing sheet.

The code runs beautifully the first time. Any time there is a missing
sheet on the list, the code copies the "Template" sheet and renames
it, accordingly.

Where the code runs into problems is upon sheet deletion. If I select
a range of sheets (manually) and delete them from the workbook, the
code is unable to access the "Copy Worksheets" method upon re-run.

I have seen others post about this bug in Excel and am wondering if
anyone knows/has a work-around.

Here is the code. It is a bit complicated as it uses Global
Variables, but hopefully the names make sense. Please ask questions
or offer advice. Thanks, Thaddeus

--------------------


Option Explicit
Option Base 1 ''set the first array address to 1 instead
of zero.

Sub ADD_TEMPLATE_SHEETS()
'
' Written 5/25/2007 by tagar
'

Dim cntsheet As Long '''The count of sheets in the book at the
start of sub.
Dim cntsheetplus As Variant '''A counter on the increment of
sheets, used to add new sheets to the end of the book.
Dim nmSheet As Variant '''used to iterate through cntsheets
Dim nmAddSheet As Variant '''the name of the sheet to check and add
Dim addTarget As Variant '''target boolean to determine if sheet
exists
Dim i As Long '''Page counter for lngRowMax
Dim j As Long '''Page counter for lngColMax
Dim lngRowCount As Long '''the counter column number
Dim lngColCount As Long '''the actual column number
Dim sheetArray() As Variant '''
Dim arrayIndex As Long


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''
'''Get Global Variables!!
'''
PROJECT_GLOBALS.GET_GLOBALS

Workbooks(nmWorkbook).Activate

cntsheet = Workbooks(nmWorkbook).Worksheets.Count '''Get the count of
worksheets in the workbook
cntsheetplus = cntsheet '''assign the initial
value to cntsheetsplus


''''enter all sheet names into an array
ReDim sheetArray(1 To cntsheet + 10)
For nmSheet = 1 To cntsheet
sheetArray(nmSheet) = Sheets(nmSheet).Name
Next nmSheet

lngColCount = Worksheets(nmConsoleSheet).Cells(24,
6).End(xlToRight).Column - 5
lngRowCount = Worksheets(nmConsoleSheet).Cells(24, 5).End(xlDown).Row
- 24


For i = 1 To lngRowCount '''for each sheet to add (row)
For j = 1 To lngColCount '''for each data type (column)
addTarget = 0
'''Display Work Update Status
Sheets(nmConsoleSheet).Activate
Sheets(nmConsoleSheet).Cells(19, 4).Value = "Checking " & nmAddSheet
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.DisplayAlerts = False
Application.ScreenUpdating = False

For arrayIndex = 1 To cntsheet '''check to see if sheet already exists
in workbook.


'''Assemble the name of the sheet to check/add if missing
If arrayIndex = 1 Then
nmAddSheet =
Workbooks(nmWorkbook).Sheets(nmConsoleSheet).Cells(i + 24, 5).Value &
"-" & Sheets(nmConsoleSheet).Cells(24, j + 5).Value
End If

If sheetArray(arrayIndex) = nmAddSheet Then
addTarget = 1 ''''Get the name if sheet exists
arrayIndex = cntsheet
'MsgBox ("Do Nothing")
End If


Next arrayIndex '''check all sheets to see if nmAddSheet
already exists. If yes, do nothing.


If addTarget = 0 Then
Workbooks(nmWorkbook).Sheets(nmTemplateSheet).Copy
After:=Workbooks(nmWorkbook).Sheets(Sheets.Count) '(cntsheetplus)
Workbooks(nmWorkbook).Sheets(nmTemplateSheet &
" (2)").Name = nmAddSheet
cntsheetplus = cntsheetplus + 1 '''since the sheet
was added, increment cntsheetsplus so the next sheet will still be
added to the end of the workbook.
End If

Next j '''continue for each Data Type (columns)
Next i '''continue for all sheets to be checked/added (rows)



'''Display Work Update Status
Sheets(nmConsoleSheet).Activate
Sheets(nmConsoleSheet).Cells(19, 4).Value = "Complete"
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub
 
D

Don Guillett

Might be easier? Assumes you have a list


Sub makesheetifnotonlist()
For Each c In Range("mylist")

On Error Resume Next
If Worksheets(c.Value) Is Nothing Then
Sheets("Template").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = c
End If

Next c
End Sub
 
T

Thaddeus

Might be easier? Assumes you have a list

Sub makesheetifnotonlist()
For Each c In Range("mylist")

On Error Resume Next
If Worksheets(c.Value) Is Nothing Then
Sheets("Template").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = c
End If

Next c
End Sub

Not sure this resolves the issue though. The problem is that once a
large range of sheets are deleted from a workbook, it is not possible
(manually or otherwise) to copy an existing sheet.

Right now, I am not under the impression that this is related to the
code. Thanks for the suggestion. I will see if it works give the way
my list is matrixed.
 
T

Thaddeus

I modified your code slightly in order to handle the matrixed nature
of my data entry. The code looks like this. However, I am still
getting the same error in excel. Once a significant number of pages
are generated, if you delete a bunch of them and then run the code
again, it will fail on the Worksheet Copy method.

Can you please try this and see if you can confirm? After 1 or two
times, I get the error/issue.




Sub makesheetifnotonlist()
For Each c In Sheets("Console").Range("mylist_1")
For Each d In Sheets("Console").Range("mylist_2")

On Error Resume Next
If Worksheets(c & "-" & d.Value) Is Nothing Then
Sheets("Template").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = c & "-" & d
End If

Next d
Next c
End Sub

Enter a lower-case "x" for each Data Type that should be excluded
during page generation.
Tables Figures Text Drawings
Tab Name T F X D
1 x
2 x
3 x
4 x
5 x
6 x
7 x
 
D

Don Guillett

I don't understand what mylist_2 is. What is the layout? You may send me the
workbook if you like and I will take a look.
 
T

Thaddeus

The data is in an X by Y array. For each X there is 1 or more Ys.
There is a drawing at the bottom of my previous post. In any event,
I'm not sure that matters much. The issues I encounter with either
set of codes is as follows. If you use the code to generate 100-200
worksheets and then delete all 100-200 worksheets, the code will
encounter an error once you run it again. The error is intermittent.
It does not occur at a specific point during subsequent runs.
Sometimes it happens immediately. Other times it happens on the 2nd
or 3rd run. Please run your code several times, follow this
procedure, and let me know if you encounter the issue.
 

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