Check if sheetname exists before create

Vincent88

Active Member
Joined
Mar 5, 2021
Messages
382
Office Version
  1. 2019
Platform
  1. Windows
  2. Mobile
I run my code to duplicate a worksheet. If the worksheet is already existed , then no duplication of sheet and message box (Sheet (sheetname) does exists) will show. But this message box will also pop up when new sheet is created but I do not want this. I only want this msg box to pop up when I run the marco again and found the same sheetname already there. Please help.

VBA Code:
Function DoesSheetExists(sh As String) As Boolean
    Dim ws As Worksheet

    On Error Resume Next
       Set ws = Sheets(sh)
    On Error GoTo 0

    If Not ws Is Nothing Then DoesSheetExists = True
End Function

Sub Check()
     Dim szToday As String
     szToday = Format(Date, "d mmm yyyy")
    

    If DoesSheetExists(szToday) Then
        MsgBox "Sheet " & szToday & " does exists"
     Else
         Call Module18.BlankSheet03
         MsgBox "Sheet" & szToday & " Created"
    End If
End Sub
 
Hi Vinecent,

MsgBox is called via Worksheet_SelectionChange behind the Activesheet.

Use this altered code for Module1:

Code:
Sub BlankSheet()
  Dim ws As Worksheet
  Dim LastColumn As Long
  Dim strSheetName As String

  If ActiveWorkbook Is ThisWorkbook Then
    Set ws = ActiveSheet

    LastColumn = ws.Range("A1").CurrentRegion.Columns.Count

    On Error Resume Next
    Application.EnableEvents = False
  ''  ws.Range(Cells(1, 1), Cells(1, LastColumn)).Copy
    ws.Copy before:=ActiveSheet
    strSheetName = Format(Date, "d mmm yyyy")
    ActiveSheet.Name = strSheetName

    'Clear All Contents
    With ActiveSheet
      .Cells.ClearContents
      With .OLEObjects
        .Visible = True
        .Delete
      End With
      With .Pictures
        .Visible = True
        .Delete
      End With
      .Range("A1").Resize(1, LastColumn).Value = ws.Range("A1").Resize(1, LastColumn).Value
      .ListObjects.Add(xlSrcRange, .Range("A1").Resize(2, LastColumn), , xlYes).Name = strSheetName
      .ListObjects(strSheetName).TableStyle = "TableStyleMedium2"
      .ListObjects(strSheetName).ShowAutoFilterDropDown = False
    Application.EnableEvents = True
    End With
    Set ws = Nothing
  End If

End Sub
Ciao,
Holger
 
Upvote 0

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Place these macros in a regular module and run the "Check" macro.
VBA Code:
Sub Check()
    Application.ScreenUpdating = False
    Dim szToday As String
    szToday = Format(Date, "d mmm yyyy")
    If Not Evaluate("isref('" & szToday & "'!A1)") Then
        Call BlankSheet
        MsgBox "Sheet " & szToday & " created."
    Else
        MsgBox "Sheet " & szToday & " exists."
    End If
    Application.ScreenUpdating = True
End Sub

Sub BlankSheet()
  Dim ws As Worksheet
  Dim LastColumn As Long
  Dim strSheetName As String

  If ActiveWorkbook Is ThisWorkbook Then
    Set ws = ActiveSheet
 
    LastColumn = ws.Range("A1").CurrentRegion.Columns.Count
 
    On Error Resume Next
    Application.DisplayAlerts = False
  ''  ws.Range(Cells(1, 1), Cells(1, LastColumn)).Copy
    ws.Copy before:=ActiveSheet
    strSheetName = Format(Date, "d mmm yyyy")
    ActiveSheet.Name = strSheetName
    Application.DisplayAlerts = True
 
    'Clear All Contents
    Application.EnableEvents = False
    With ActiveSheet
      .Cells.ClearContents
      With .OLEObjects
        .Visible = True
        .Delete
      End With
      With .Pictures
        .Visible = True
        .Delete
      End With
      .Range("A1").Resize(1, LastColumn).Value = ws.Range("A1").Resize(1, LastColumn).Value
      .ListObjects.Add(xlSrcRange, .Range("A1").Resize(2, LastColumn), , xlYes).Name = strSheetName
      .ListObjects(strSheetName).TableStyle = "TableStyleMedium2"
      .ListObjects(strSheetName).ShowAutoFilterDropDown = False
    End With
    Application.EnableEvents = True
    Set ws = Nothing
  End If

End Sub
 
Upvote 0
Solution
Place these macros in a regular module and run the "Check" macro.
VBA Code:
Sub Check()
    Application.ScreenUpdating = False
    Dim szToday As String
    szToday = Format(Date, "d mmm yyyy")
    If Not Evaluate("isref('" & szToday & "'!A1)") Then
        Call BlankSheet
        MsgBox "Sheet " & szToday & " created."
    Else
        MsgBox "Sheet " & szToday & " exists."
    End If
    Application.ScreenUpdating = True
End Sub

Sub BlankSheet()
  Dim ws As Worksheet
  Dim LastColumn As Long
  Dim strSheetName As String

  If ActiveWorkbook Is ThisWorkbook Then
    Set ws = ActiveSheet
 
    LastColumn = ws.Range("A1").CurrentRegion.Columns.Count
 
    On Error Resume Next
    Application.DisplayAlerts = False
  ''  ws.Range(Cells(1, 1), Cells(1, LastColumn)).Copy
    ws.Copy before:=ActiveSheet
    strSheetName = Format(Date, "d mmm yyyy")
    ActiveSheet.Name = strSheetName
    Application.DisplayAlerts = True
 
    'Clear All Contents
    Application.EnableEvents = False
    With ActiveSheet
      .Cells.ClearContents
      With .OLEObjects
        .Visible = True
        .Delete
      End With
      With .Pictures
        .Visible = True
        .Delete
      End With
      .Range("A1").Resize(1, LastColumn).Value = ws.Range("A1").Resize(1, LastColumn).Value
      .ListObjects.Add(xlSrcRange, .Range("A1").Resize(2, LastColumn), , xlYes).Name = strSheetName
      .ListObjects(strSheetName).TableStyle = "TableStyleMedium2"
      .ListObjects(strSheetName).ShowAutoFilterDropDown = False
    End With
    Application.EnableEvents = True
    Set ws = Nothing
  End If

End Sub
It works now. Thanks
 
Upvote 0
Hi Vinecent,

MsgBox is called via Worksheet_SelectionChange behind the Activesheet.

Use this altered code for Module1:

Code:
Sub BlankSheet()
  Dim ws As Worksheet
  Dim LastColumn As Long
  Dim strSheetName As String

  If ActiveWorkbook Is ThisWorkbook Then
    Set ws = ActiveSheet

    LastColumn = ws.Range("A1").CurrentRegion.Columns.Count

    On Error Resume Next
    Application.EnableEvents = False
  ''  ws.Range(Cells(1, 1), Cells(1, LastColumn)).Copy
    ws.Copy before:=ActiveSheet
    strSheetName = Format(Date, "d mmm yyyy")
    ActiveSheet.Name = strSheetName

    'Clear All Contents
    With ActiveSheet
      .Cells.ClearContents
      With .OLEObjects
        .Visible = True
        .Delete
      End With
      With .Pictures
        .Visible = True
        .Delete
      End With
      .Range("A1").Resize(1, LastColumn).Value = ws.Range("A1").Resize(1, LastColumn).Value
      .ListObjects.Add(xlSrcRange, .Range("A1").Resize(2, LastColumn), , xlYes).Name = strSheetName
      .ListObjects(strSheetName).TableStyle = "TableStyleMedium2"
      .ListObjects(strSheetName).ShowAutoFilterDropDown = False
    Application.EnableEvents = True
    End With
    Set ws = Nothing
  End If

End Sub
Ciao,
Holger
The code will lead to a popup to confirm the dropdown list name.
 
Upvote 0
Hi Vincent88,

first of all please stop answering with full quotes of the posts. If you address the person you can still refer to passages of the post but there is really no use in full quotes.

I would kindly ask both you and mumps to do me a favour. load the workbook you uploaded for testing, delete any sheets except "1 Jan 2021" and "Agents". then move the cursor on "1 Jan 2021" to any other cell than D1 and back to D1 again. I see a MsgBox telling me that the sheet with today´s name exists although it´s not visible in the workbook by then, this happens when I get the box to disappear.

We have supplied code to suppress that message if you start the code from one module but the event is still firing.

And I still wonder what Application.DisplayAlerts is good for in the code.

Ciao,
Holger
 
Upvote 0
Hi Vincent,

this will be a rather long post from my side. Please stay with me and read through it as I would like to point out alterations.

In ThisWorkbook you create a shortcut for creating a new sheet. And behind the sheets with the dates you use the target of Range(“D1”) to trigger the very same macro. As any user who hasn´t worked with the application before I would like to be informed the behaviour on some information sheet in order to use the possibilities inside the workbook. If you want to stick with this make sure that the codes being called are the very same.

Sheet Agents:
I really appreciate the work of using Array-Formulas and normal formulas to create a sorted list. And I somehow feel that using a copy the values over and sort the list ascending might be a way to solve it with VBA.

Sheet 1 Jan 2021
Column C shows Header Chase Date. Inside the code in the comment you claim Auto Insert Date in Column C but what you really do is insert the sheetname which will not change unless you change the name of the sheet. If always the sheetname would be inserted I consider Column C to be obsolete.

Validation List in Column B: I think it´s due to my system but I can´t get the Data/Validation list to work. If I look it up in the Name Manager I find the list at at least 2 positions. Like stated this might be caused by my system.

Request No in Column A: I don´t know what may be entered into cells in Column A. So the use of Regular Expressions might still be necessary.

And the pictures in Column E really blow the size up. As far as I remember any picture will be converted to bitmap and saved inside the workbook (this may have been changed but the two images made up for 500 K for your workbook). Size nowadays is no matter so just information from my side. I can´t judge the importance or the use of the images so no alterations will be made from my side for this.

Code behind sheet 1 Jan 2021:

Worksheet_Change: should be revised as due to using a table/list most of the information you set is drawn from the cell above. Only the Chase Date/Sheetname would be of interest from what I see.

I mentioned before that any code behind the sheet would be copied over to the new sheet so I would recommend to use ThisWorkbook and Workbook_SheetChange and comment out the event behind the sheet (or delete it once the code in ThisWorkbook is working as expected)

Code may look like this:
VBA Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

  Select Case Sh.Name
    Case "Agents"
      Exit Sub
    Case Else
  End Select
 
  If Target.Column > 3 Or Target.CountLarge > 1 Then Exit Sub
  If Target.Row = 1 Then Exit Sub
 
  Application.EnableEvents = False
  If Cells(Target.Row, "A") <> "" And Cells(Target.Row, "B") <> "" Then
      Cells(Target.Row, "C") = ActiveSheet.Name
  Else
      Cells(Target.Row, "C").ClearContents
      Cells(Target.Row, "D").ShrinkToFit = False
  End If
 
  If Target.Column = 1 Then
    Dim s As String
    Dim arr As Variant
 
    s = Target.Value
    If s = "" Then
      Target.NumberFormat = "General"
    Else
      With CreateObject("vbscript.regexp")
        .Pattern = "[^0-9]"
        .Global = True
        .IgnoreCase = True
        arr = Split(Application.Trim(.Replace(s, " ")), " ")
      End With
      Target.Value = arr
      Target.Value = Target.Value * 1
      Target.NumberFormat = """REQ0000000""General"
    End If
  End If
  Application.EnableEvents = True

End Sub
For BeforeRightClick the code may look like this for ThisWorkbook:
VBA Code:
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

  Select Case Sh.Name
    Case "Agents"
      Exit Sub
    Case Else
  End Select

  If Target.Column <> 5 Or Application.CountA(Cells(Target.Row, 1).Resize(, 2)) < 2 Then Exit Sub
  Cancel = True
  Call Module3.SelectOLE

End Sub

Last event is Workbook_SheetSelectionChange where I introduced a global Boolean for this event (same may be done for the Change-Event with a slightly different name). The declaration is in Module1 (shown later on)
VBA Code:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

  Select Case Sh.Name
    Case "Agents"
      Exit Sub
    Case Else
  End Select

  If g_blnWbkShtSelChange Then Exit Sub
  If Selection.Count = 1 Then
    If Not Intersect(Target, Range("D1")) Is Nothing Then
      g_blnWbkShtSelChange = True
      Call Module1.CheckSheet
    End If
  End If

End Sub

Like stated above the codes may be commented out for testing and be deleted later as they are located in one place for all sheets.

What´s missing is the code for Module1:
VBA Code:
Global g_blnWbkShtSelChange As Boolean
'

Sub CreateCheck()
  Application.OnKey "^{BS}", "CheckSheet"

End Sub
Sub DeleteCheck()
  Application.OnKey "^{BS}"

End Sub

'https://www.mrexcel.com/board/threads/check-if-sheetname-exists-before-create.1169941/#post-5685592
Sub CheckSheet()
    Application.ScreenUpdating = False
    Dim szToday As String
    szToday = Format(Date, "d mmm yyyy")
    If Not Evaluate("isref('" & szToday & "'!A1)") Then
        Call BlankSheet
    End If
    Application.ScreenUpdating = True
End Sub

'https://www.mrexcel.com/board/threads/copy-table-headers-from-current-sheet-to-newly-created-sheet-in-excel-vba.1169715/
Sub BlankSheet()
  Dim ws As Worksheet
  Dim LastColumn As Long
  Dim strSheetName As String

  If ActiveWorkbook Is ThisWorkbook Then
    Set ws = ActiveSheet
 
    LastColumn = ws.Range("A1").CurrentRegion.Columns.Count
 
    On Error Resume Next
    ws.Copy before:=ActiveSheet
    strSheetName = Format(Date, "d mmm yyyy")
    ActiveSheet.Name = strSheetName
    On Error GoTo 0
 
    'Clear All Contents
    With ActiveSheet
      .Cells.ClearContents
      With .OLEObjects
        .Visible = True
        .Delete
      End With
      With .Pictures
        .Visible = True
        .Delete
      End With
      .Range("A1").Resize(1, LastColumn).Value = ws.Range("A1").Resize(1, LastColumn).Value
      .ListObjects.Add(xlSrcRange, .Range("A1").Resize(2, LastColumn), , xlYes).Name = strSheetName
      .ListObjects(strSheetName).TableStyle = "TableStyleMedium2"
      .ListObjects(strSheetName).ShowAutoFilterDropDown = False
    End With
    Set ws = Nothing
    g_blnWbkShtSelChange = False
  End If

End Sub
Maybe consider a completely different approach in using UserRom(s) to egt the information to be transported to the cells while the sheets are protected with the additional parameter UserInterfacxecOnly:=True which would enable macros to work while any user would not be able to change information. Please mind that the setting of the parameter is volatile: you woiuld need ti maybe use the Workbook_Open command and loop through the sheets in order to protect them the way you want.

Maybe any of the ideas might be of some help for you.
Holger
 
Upvote 0
Hi HaHoBe,
Thank you for your valuable time to fine tune mine. I will complete my last vba code to send email with insertion of the picture using the embedded object. Then I will come back to modify as your suggestons. ?
 
Upvote 0
Hi Vincent,

this will be a rather long post from my side. Please stay with me and read through it as I would like to point out alterations.

In ThisWorkbook you create a shortcut for creating a new sheet. And behind the sheets with the dates you use the target of Range(“D1”) to trigger the very same macro. As any user who hasn´t worked with the application before I would like to be informed the behaviour on some information sheet in order to use the possibilities inside the workbook. If you want to stick with this make sure that the codes being called are the very same.

Sheet Agents:
I really appreciate the work of using Array-Formulas and normal formulas to create a sorted list. And I somehow feel that using a copy the values over and sort the list ascending might be a way to solve it with VBA.

Sheet 1 Jan 2021
Column C shows Header Chase Date. Inside the code in the comment you claim Auto Insert Date in Column C but what you really do is insert the sheetname which will not change unless you change the name of the sheet. If always the sheetname would be inserted I consider Column C to be obsolete.

Validation List in Column B: I think it´s due to my system but I can´t get the Data/Validation list to work. If I look it up in the Name Manager I find the list at at least 2 positions. Like stated this might be caused by my system.

Request No in Column A: I don´t know what may be entered into cells in Column A. So the use of Regular Expressions might still be necessary.

And the pictures in Column E really blow the size up. As far as I remember any picture will be converted to bitmap and saved inside the workbook (this may have been changed but the two images made up for 500 K for your workbook). Size nowadays is no matter so just information from my side. I can´t judge the importance or the use of the images so no alterations will be made from my side for this.

Code behind sheet 1 Jan 2021:

Worksheet_Change: should be revised as due to using a table/list most of the information you set is drawn from the cell above. Only the Chase Date/Sheetname would be of interest from what I see.

I mentioned before that any code behind the sheet would be copied over to the new sheet so I would recommend to use ThisWorkbook and Workbook_SheetChange and comment out the event behind the sheet (or delete it once the code in ThisWorkbook is working as expected)

Code may look like this:
VBA Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

  Select Case Sh.Name
    Case "Agents"
      Exit Sub
    Case Else
  End Select
 
  If Target.Column > 3 Or Target.CountLarge > 1 Then Exit Sub
  If Target.Row = 1 Then Exit Sub
 
  Application.EnableEvents = False
  If Cells(Target.Row, "A") <> "" And Cells(Target.Row, "B") <> "" Then
      Cells(Target.Row, "C") = ActiveSheet.Name
  Else
      Cells(Target.Row, "C").ClearContents
      Cells(Target.Row, "D").ShrinkToFit = False
  End If
 
  If Target.Column = 1 Then
    Dim s As String
    Dim arr As Variant
 
    s = Target.Value
    If s = "" Then
      Target.NumberFormat = "General"
    Else
      With CreateObject("vbscript.regexp")
        .Pattern = "[^0-9]"
        .Global = True
        .IgnoreCase = True
        arr = Split(Application.Trim(.Replace(s, " ")), " ")
      End With
      Target.Value = arr
      Target.Value = Target.Value * 1
      Target.NumberFormat = """REQ0000000""General"
    End If
  End If
  Application.EnableEvents = True

End Sub
For BeforeRightClick the code may look like this for ThisWorkbook:
VBA Code:
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

  Select Case Sh.Name
    Case "Agents"
      Exit Sub
    Case Else
  End Select

  If Target.Column <> 5 Or Application.CountA(Cells(Target.Row, 1).Resize(, 2)) < 2 Then Exit Sub
  Cancel = True
  Call Module3.SelectOLE

End Sub

Last event is Workbook_SheetSelectionChange where I introduced a global Boolean for this event (same may be done for the Change-Event with a slightly different name). The declaration is in Module1 (shown later on)
VBA Code:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

  Select Case Sh.Name
    Case "Agents"
      Exit Sub
    Case Else
  End Select

  If g_blnWbkShtSelChange Then Exit Sub
  If Selection.Count = 1 Then
    If Not Intersect(Target, Range("D1")) Is Nothing Then
      g_blnWbkShtSelChange = True
      Call Module1.CheckSheet
    End If
  End If

End Sub

Like stated above the codes may be commented out for testing and be deleted later as they are located in one place for all sheets.

What´s missing is the code for Module1:
VBA Code:
Global g_blnWbkShtSelChange As Boolean
'

Sub CreateCheck()
  Application.OnKey "^{BS}", "CheckSheet"

End Sub
Sub DeleteCheck()
  Application.OnKey "^{BS}"

End Sub

'https://www.mrexcel.com/board/threads/check-if-sheetname-exists-before-create.1169941/#post-5685592
Sub CheckSheet()
    Application.ScreenUpdating = False
    Dim szToday As String
    szToday = Format(Date, "d mmm yyyy")
    If Not Evaluate("isref('" & szToday & "'!A1)") Then
        Call BlankSheet
    End If
    Application.ScreenUpdating = True
End Sub

'https://www.mrexcel.com/board/threads/copy-table-headers-from-current-sheet-to-newly-created-sheet-in-excel-vba.1169715/
Sub BlankSheet()
  Dim ws As Worksheet
  Dim LastColumn As Long
  Dim strSheetName As String

  If ActiveWorkbook Is ThisWorkbook Then
    Set ws = ActiveSheet
 
    LastColumn = ws.Range("A1").CurrentRegion.Columns.Count
 
    On Error Resume Next
    ws.Copy before:=ActiveSheet
    strSheetName = Format(Date, "d mmm yyyy")
    ActiveSheet.Name = strSheetName
    On Error GoTo 0
 
    'Clear All Contents
    With ActiveSheet
      .Cells.ClearContents
      With .OLEObjects
        .Visible = True
        .Delete
      End With
      With .Pictures
        .Visible = True
        .Delete
      End With
      .Range("A1").Resize(1, LastColumn).Value = ws.Range("A1").Resize(1, LastColumn).Value
      .ListObjects.Add(xlSrcRange, .Range("A1").Resize(2, LastColumn), , xlYes).Name = strSheetName
      .ListObjects(strSheetName).TableStyle = "TableStyleMedium2"
      .ListObjects(strSheetName).ShowAutoFilterDropDown = False
    End With
    Set ws = Nothing
    g_blnWbkShtSelChange = False
  End If

End Sub
Maybe consider a completely different approach in using UserRom(s) to egt the information to be transported to the cells while the sheets are protected with the additional parameter UserInterfacxecOnly:=True which would enable macros to work while any user would not be able to change information. Please mind that the setting of the parameter is volatile: you woiuld need ti maybe use the Workbook_Open command and loop through the sheets in order to protect them the way you want.

Maybe any of the ideas might be of some help for you.
Holger
Hi HaHoBe,
There is error when implementing the module 1. See screenshots
 

Attachments

  • module1error2.png
    module1error2.png
    15.1 KB · Views: 7
  • module1error3.png
    module1error3.png
    14.2 KB · Views: 7
  • module1error.png
    module1error.png
    18.1 KB · Views: 7
Upvote 0
Hi Vincent,

there is a table as well as there are pictures on the sheet - just the same as it was when you uploaded the sample workbook? The line highlighted shows up when there is no listohject/table.

Ciao,
Holger
 
Upvote 0
Hi Vincent88,

try adjusting the coide from
Code:
...
    With ActiveSheet
      .Cells.ClearContents
      With .OLEObjects
        .Visible = True
        .Delete
      End With
      With .Pictures
        .Visible = True
        .Delete
      End With
      .Range("A1").Resize(1, LastColumn).Value = ws.Range("A1").Resize(1, LastColumn).Value
...
to
Code:
...
    With ActiveSheet
      .Cells.ClearContents
      With .OLEObjects
        If .Count > 0 Then
          .Visible = True
          .Delete
        End If
      End With
      With .Pictures
        If .Count > 0 Then
          .Visible = True
          .Delete
        End If
      End With

...
Ciao,
Holger
 
Upvote 0

Forum statistics

Threads
1,213,538
Messages
6,114,218
Members
448,554
Latest member
Gleisner2

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