Check sheet name against a named range and delete if not found

V

Viper147

New Member
Joined
Apr 19, 2018
Messages
34
Hi everyone,
I copied a piece of code from another forum for a project I am busy with and amended it here and there as per my needs. All was working perfect until I realized that, despite my instructions, some of the staff would insert additional sheets that they are not supposed to. It works as follows:
The file contains a number of sheets that would be amended according to a list on a separate sheet (Agents), which is all done with the code below. However there are a number of data sheets that are constant and are therefore not included as part of the process of sheet manipulation of the code. These sheets used to be listed separately in the code (specifically the line I get the error on now marked in bold). I then decided to create a named range with an "offset" function to dynamically keep track of these sheets, and exclude them from the actions of the macro. But, after this change, I now get the "Type mismatch" error. I know why the error occurs, but not sure how to fix it (still a bit of a noob with VBA, but learning).

Any help will be appreciated.

Code: 
[FONT=Calibri][SIZE=3][COLOR=#000000]Sub AmendSheets()[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim wksInput As Worksheet[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim wks As Worksheet[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim cell As Range[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim MaxRow As Long[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim NotFound As Boolean[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim Removed As String[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim Added As String[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim SheetRange As Range[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim c As Range[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Set wksInput =Worksheets("Agents")[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    MaxRow =wksInput.Range("A" & Rows.Count).End(xlUp).Row[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]   Application.ScreenUpdating = False[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    'Delete worksheetsthat don't match sheet names on the list[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    For Each wks InWorksheets[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        NotFound =True[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        'Keep Indexand Template worksheets safe[/COLOR][/SIZE][/FONT]
[B][FONT=Calibri][SIZE=3][COLOR=#000000]        If Not(wks.Name Like Range("IndexSheets")) Then    'I get a Type Mismatch error on this line[/COLOR][/SIZE][/FONT][/B]
[FONT=Calibri][SIZE=3][COLOR=#000000]            'Check allcurrent sheet names for matches[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            For Eachcell In wksInput.Range("A2:A" & MaxRow)[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                Ifwks.Name Like cell Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                   NotFound = False[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                   Exit For[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            Next cell[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        Else[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            NotFound =False[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        'Match was notfound, delete worksheet[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        If NotFoundThen[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            'Build endmessage[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            IfLenB(Removed) = 0 Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]               Removed = "Worksheet '" & wks.Name & "'"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            Else[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]               Removed = Removed & " & '" & wks.Name &"'"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            'Delete worksheet[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]           Application.DisplayAlerts = False[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            wks.Delete[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]           Application.DisplayAlerts = True[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Next wks[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    'Check each sheetname for existing worksheet, copy from template if not found[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    For Each cell InwksInput.Range("A2:A" & MaxRow)[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        NotFound =True[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        For Each wksIn Worksheets[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            Ifwks.Name Like cell Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]               NotFound = False[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                ExitFor[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        Next wks[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        'Sheet name wasn'tfound, copy template[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        If NotFoundAnd LenB(Trim(cell & vbNullString)) <> 0 Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            'Build endmessage[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            IfLenB(Added) = 0 Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                Added= "Worksheet '" & cell & "'"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            Else[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                Added= Added & " & '" & cell & "'"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            'Add theworksheet[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]           Worksheets("Template").Copyafter:=Worksheets(Worksheets.Count)[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]           ActiveSheet.Name = cell[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Next cell[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]   Application.ScreenUpdating = True[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    'Final messagetouchups and display to user[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    If LenB(Removed)<> 0 And LenB(Added) <> 0 Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        Removed =Removed & " has been removed from the workbook." & vbNewLine& vbNewLine[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        Added = Added& " has been added to the workbook, and sheets sorted."[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        MsgBox Removed& Added, vbOKOnly, "Task completed"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    ElseIfLenB(Removed) <> 0 Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        Removed =Removed & " has been removed from the workbook, and sheetssorted."[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        MsgBoxRemoved, vbOKOnly, "Task completed"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    ElseIf LenB(Added)<> 0 Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        Added = Added& " has been added to the workbook, and sheets sorted."[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        MsgBox Added,vbOKOnly, "Task completed"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    ElseIf LenB(Added)= 0 And LenB(Removed) = 0 Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        MsgBox"No additions or deletions made to the workbook. All sheets sorted.",vbOKOnly, "Task completed"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim i As Long[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]  [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]  'Sorts all thesheets in the order as per the list on the Agents sheet[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]  WithSheets("Agents")[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    On Error ResumeNext[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    For i =.Range("A" & .Rows.Count).End(xlUp).Row To 1 Step -1[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]      Sheets(.Cells(i,1).Value).Move Before:=Sheets(5)[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Next i[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    On Error GoTo 0[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]  End With[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]  [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Sheets("Currency").Activate[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Range("A1").Select[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT="Calibri"][COLOR=#000000]End Sub[/COLOR][/FONT]
​
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sort by date Sort by votes
Prevention is better than cure :banghead:

How about avoiding the problem by preventing users adding, moving, hiding, unhiding or deleting sheets
- click on Review tab
- click on Protect workbook
- protect with a password

If VBA is required to unhide, hide, add, delete or move sheets ...
Code: 
Sub XXX()
[COLOR=#006400][I]Lift protection[/I][/COLOR]
    ThisWorkbook.Unprotect "password"

[I]   code to unhide, hide, add, delete or move sheets goes here[/I]
[I][COLOR=#006400]Re-instate[/COLOR][/I]
    ThisWorkbook.Protect Password:="password", Structure:=True, Windows:=False
End Sub
 
Last edited:
Upvote 0
Thanks for your assistance and advice.
The problem is that at times there are valid reasons for the additions. As a result I am trying to keep the code as dynamic as possible to cater for any unforeseen circumstances.
 
Upvote 0
In short, I created a formula to keep track of the number of index sheets and assigned a range name to it. Then cycled through the sheets to identify the index sheets. Below is the code as it stands now, just some cleaning up to do.

Code: 
[FONT=Calibri][SIZE=3][COLOR=#000000]Sub AmendSheets()[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim wksInput As Worksheet[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim wks As Worksheet[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim cell As Range[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim MaxRow As Long[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim NotFound As Boolean[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim Removed As String[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim Added As String[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim SheetRange As Range[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim c As Range[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim Count As Long[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]   ThisWorkbook.Sheets.Select[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]   ActiveSheet.Calculate[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Sheets(1).Select[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Set wksInput =Worksheets("Agents")[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Count =Range("Count2")[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    MaxRow =wksInput.Range("A" & Rows.Count).End(xlUp).Row[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]   Application.ScreenUpdating = False[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]'Delete worksheets that don't match sheet names on the list[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    For Each wks InWorksheets[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        NotFound =True[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]'Keep Index and Template worksheets safe[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]      [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        If wks.Index> Count Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                   [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]'Check all current sheet names for matches[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]'Delete worksheets that don't match sheet names on the list[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            For Eachcell In wksInput.Range("A2:A" & MaxRow)[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                Ifwks.Name Like cell Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                   NotFound = False[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                    Exit For[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            Next cell[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        Else[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            NotFound =False[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]'Match was not found, delete worksheet[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        If NotFoundThen[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]'Build end message[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            IfLenB(Removed) = 0 Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                Removed= "Worksheet '" & wks.Name & "'"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            Else[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]               Removed = Removed & " & '" & wks.Name &"'"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]'Delete worksheet[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]           Application.DisplayAlerts = False[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            wks.Delete[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]           Application.DisplayAlerts = True[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Next wks[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]'Check each sheet name for existing worksheet, copy fromtemplate if not found[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    For Each cell InwksInput.Range("A2:A" & MaxRow)[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        NotFound =True[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        For Each wksIn Worksheets[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            Ifwks.Name Like cell Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]               NotFound = False[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                ExitFor[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        Next wks[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]'Sheet name wasn't found, copy template[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        If NotFoundAnd LenB(Trim(cell & vbNullString)) <> 0 Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]'Build end message[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            IfLenB(Added) = 0 Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                Added= "Worksheet '" & cell & "'"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            Else[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]                Added= Added & " & '" & cell & "'"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]'Add the worksheet[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]           Worksheets("Template").Copy after:=Worksheets(Worksheets.Count)[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]           ActiveSheet.Name = cell[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Next cell[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]'Final message touchups and display to user[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    If LenB(Removed)<> 0 And LenB(Added) <> 0 Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        Removed =Removed & " has been removed from the workbook." & vbNewLine& vbNewLine[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        Added = Added& " has been added to the workbook, and sheets sorted."[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        MsgBox Removed& Added, vbOKOnly, "Task completed"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    ElseIfLenB(Removed) <> 0 Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        Removed =Removed & " has been removed from the workbook, and sheetssorted."[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        MsgBoxRemoved, vbOKOnly, "Task completed"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    ElseIf LenB(Added)<> 0 Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        Added = Added& " has been added to the workbook, and sheets sorted."[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        MsgBox Added,vbOKOnly, "Task completed"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    ElseIf LenB(Added)= 0 And LenB(Removed) = 0 Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        MsgBox"No additions or deletions made to the workbook. All sheets sorted.",vbOKOnly, "Task completed"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim i As Long[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]  [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]'Sorts all the sheets in the order as per the list on theAgents sheet[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]  With Sheets(1)[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    On Error ResumeNext[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    For i =.Range("A" & .Rows.Count).End(xlUp).Row To 1 Step -1[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]      Sheets(.Cells(i,1).Value).Move Before:=Sheets(Count + 1)[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Next i[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    On Error GoTo 0[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]  End With[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]  [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Application.ScreenUpdating = True[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Sheets("Data").Activate[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Range("A1").Select[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]End Sub[/COLOR][/SIZE][/FONT]
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question Question
Removing Blank Cells
Replies
2
Views
102
Peter_SSs
Peter_SSs
J
  • Solved
Speeding up VBA
Replies
9
Views
271
jvoss
J
H
  • Question Question
Copy Data where Source Workbook contains Name that is in destination sheet
Replies
4
Views
211
howard
H
A
  • Question Question
VBA for setting up the printing pages per sheet
Replies
0
Views
603
Aurum1
A
D
  • Question Question
VBA Code to Apply an AVERAGE of a Range on Cells as New Records are added Via a User Form
Replies
2
Views
97
Denny57
D

Forum statistics

Threads
1,224,822
Messages
6,181,165
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top