John Joseph
John Joseph

Reputation: 207

Silently VBA add new Excel worksheet without screen update

I'm adding a new worksheet to my workbook with

Application.ScreenUpdating = False
SheetExists = False
For Each WS In Worksheets
    If WS.Name = "BLANK" Then
        SheetExists = True
    End If
Next WS
If Not SheetExists Then
    Sheets.Add
    ActiveSheet.Name = "BLANK"
End If

Is there any way to sheets.add silently without bringing focus to or activating the new added sheet? I just want to stay on the sheet (ie. Sheet1) that is currently active and add the new sheet in the background. Thanks

Upvotes: 1

Views: 1207

Answers (2)

Cristian Buse
Cristian Buse

Reputation: 4578

At first, things look simple but there are a few things to consider:

  1. There could be more sheets selected before running the code
  2. The selected sheet(s) could be Chart sheet(s)
  3. The Workbook can be protected
  4. You might not want to set Application.ScreenUpdating = True at the end of the method because you might be running this from within another method that still needs it off
  5. Restoring selection can only happen if the proper window is activated

You could use this method:

Sub AddWorksheet(ByVal targetBook As Workbook, ByVal sheetname As String)
    Const methodName As String = "AddWorksheet"
    
    'Do input checks
    If targetBook Is Nothing Then
        Err.Raise 91, methodName, "Target Book not set"
    ElseIf sheetname = vbNullString Then
        Err.Raise 5, methodName, "Sheet name cannot be blank"
    ElseIf Len(sheetname) > 31 Then
        Err.Raise 5, methodName, "Sheet name cannot exceed 31 characters"
    Else
        Dim arrForbiddenChars() As Variant
        Dim forbiddenChar As Variant
        
        arrForbiddenChars = Array(":", "\", "/", "?", "*", "[", "]")
        For Each forbiddenChar In arrForbiddenChars
            If InStr(1, sheetname, forbiddenChar) > 0 Then
                Err.Raise 5, methodName, "Sheet name cannot contain characters: : \ / ? * [ or ]"
            End If
        Next forbiddenChar
    End If

    Dim alreadyExists As Boolean
    
    'Check if a sheet already exists with the desired name
    On Error Resume Next
    alreadyExists = Not (targetBook.Sheets(sheetname) Is Nothing)
    On Error GoTo 0
    If alreadyExists Then
        MsgBox "A sheet named <" & sheetname & "> already exists!", vbInformation, "Cancelled" 'Can remove
        Exit Sub
    End If
    
    'Check if Workbook is protected
    If targetBook.ProtectStructure Then
        'Maybe write code to ask for password and then unprotect
        '
        '
        'Or simply exit
        MsgBox "Workbook is protected. Cannot add sheet", vbInformation, "Cancelled"
        Exit Sub
    End If
    
    Dim bookActiveWindow As Window
    Dim appActiveWindow As Window
    Dim selectedSheets As Sheets
    Dim screenUpdate As Boolean
    Dim newWSheet As Worksheet
    
    'Store state
    Set bookActiveWindow = targetBook.Windows(1)
    Set appActiveWindow = Application.ActiveWindow 'Can be different from the target book window
    Set selectedSheets = bookActiveWindow.selectedSheets
    screenUpdate = Application.ScreenUpdating
    
    'Do main logic
    screenUpdate = False
    If bookActiveWindow.Hwnd <> Application.ActiveWindow.Hwnd Then
        bookActiveWindow.Activate
    End If
    If selectedSheets.Count > 1 Then selectedSheets(1).Select Replace:=True
    Set newWSheet = targetBook.Worksheets.Add
    newWSheet.Name = sheetname
    
    'Restore state
    selectedSheets.Select Replace:=True
    If appActiveWindow.Hwnd <> Application.ActiveWindow.Hwnd Then
        appActiveWindow.Activate
    End If
    Application.ScreenUpdating = screenUpdate
End Sub

If you want the book containing the code then you can call with:

Sub Test()
    AddWorksheet ThisWorkbook, "BLANK"
End Sub

or, if you want the currently active book (assuming you are running this from an add-in) then you can call with:

Sub Test()
    AddWorksheet ActiveWorkbook, "BLANK"
End Sub

or any other book depending on your needs.

Upvotes: 2

Gary&#39;s Student
Gary&#39;s Student

Reputation: 96753

Just remember who was active:

Sub ytrewq()
    Dim wsh As Worksheet, SheetsExist As Boolean
    Set wsh = ActiveSheet
    
    Application.ScreenUpdating = False
        SheetExists = False
        For Each ws In Worksheets
            If ws.Name = "BLANK" Then
                SheetExists = True
            End If
        Next ws
        If Not SheetExists Then
            Sheets.Add
            ActiveSheet.Name = "BLANK"
        End If
        wsh.Activate
    Application.ScreenUpdating = False
End Sub

Upvotes: 1

Related Questions