How to program excel to insert / delete any worksheet?

E

Eric

Does anyone have any suggestions on how to program excel to insert / delete
any worksheet?
For example,
Under column A, there is a list of numbers, such as
1,4,9, ...
If there is no existing worksheet named "1", then insert a new worksheet
named under "1", else do nothing.
Repeat this process until the end of the list.

For checking, if 3 is not included under column A and there is an existing
worksheet named under "3", then delete it.
Repeat this process until the last worksheet checked.

Does anyone have any suggestions on how to code it in excel?
Thanks in advance for any suggestions
Eric
 
J

JLatham

There are 3 constant values at the start of the routine that you can alter to
fit your actual setup (most likely the sheet name needs to be changed at
least).

To put the code into your workbook, press [Alt]+[F11] to enter the VB
Editor; choose Insert | Module from the VBE menu and copy and paste this code
into the module presented. To use the code: From the regular Excel worksheet
menu, choose Tools | Macro | Macros and select SyncSheets from the list and
click the [Run] button.


Sub SyncSheets()
Const ListSheetName = "Sheet1" ' name of sheet with list
Const firstEntryRow = 1 ' change to 1st row w/sheet number
Const entryColumn = "A" ' column with list in it
Dim lastEntryRow As Long
Dim anySheet As Worksheet
Dim listRange As Range
Dim anyListEntry As Range
Dim sheetExists As Boolean
Dim sheetsToDelete() As String ' hold names to delete
Dim LC As Integer ' loop counter

lastEntryRow = _
Worksheets(ListSheetName).Range(entryColumn & _
Rows.Count).End(xlUp).Row
Set listRange = Worksheets(ListSheetName).Range( _
entryColumn & firstEntryRow & ":" & entryColumn & _
lastEntryRow)
'test if a sheet exists for a given entry
For Each anyListEntry In listRange
sheetExists = False
For Each anySheet In Worksheets
If Trim(anySheet.Name) = Trim(Str(anyListEntry)) Then
sheetExists = True
Exit For ' jump out of this loop
End If
Next
If Not sheetExists Then
Worksheets.Add before:=Worksheets(1)
ActiveSheet.Name = Trim(Str(anyListEntry))
End If
Next
'next determine if sheet(s) exist that are not
'in the list, and if any found then, delete it/them
'will reuse sheetExists for this flag also
ReDim sheetsToDelete(1 To 1) ' create the array
For Each anySheet In Worksheets
sheetExists = False
'exempt sheet with list on it from tests
If Trim(anySheet.Name) = ListSheetName Then
sheetExists = True ' don't delete this one!
Else
For Each anyListEntry In listRange
If Trim(Str(anyListEntry)) = Trim(anySheet.Name) Then
'sheet has matching entry in list
sheetExists = True
Exit For
End If
Next
If Not sheetExists Then
'an extra sheet, mark for deletion
sheetsToDelete(UBound(sheetsToDelete)) = anySheet.Name
ReDim Preserve sheetsToDelete(1 To _
UBound(sheetsToDelete) + 1)
End If
End If
Next
'run through array sheetsToDelete() and delete any entered
Application.DisplayAlerts = False ' no "may have data..." nags.
For LC = LBound(sheetsToDelete) To UBound(sheetsToDelete)
If sheetsToDelete(LC) <> "" Then
Sheets(sheetsToDelete(LC)).Delete
End If
Next
Application.DisplayAlerts = True
End Sub
 

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