I was working on several VBA macros to automate several processes and I found myself repeating certain VBA code within each sub. I decided that it would best to turn this into a public function that I can reuse over and over again.
The code may not work for everyone, but where it is most helpful is error handling or in other words error proofing the macro so users don’t do something silly like name their worksheet with disallowed characters such as \ / ? * [ or ]. If you try naming a worksheet with those characters, then you will receive this error message:
The one thing you could add to the code below at the beginning of the function is the following:
1 2 3 4 5 6 7 8 9 | With Application .StatusBar = "Please Wait" .ScreenUpdating = False .EnableEvents = False .DisplayAlerts = False .Calculation = xlManual End With |
Then add the code below at the end of the function:
1 2 3 4 5 6 7 8 9 10 | With Application .CutCopyMode = False .ScreenUpdating = True .StatusBar = False .EnableEvents = True .DisplayAlerts = True .Calculation = xlAutomatic End With |
Now don’t get upset that I included some code above that seems unnecessary to simply add a worksheet. I will explain. You really only need the DisplayAlerts for this function to work without the user being asked to confirm if a worksheet should be deleted. I actually use the code above in separate Public Functions called prepareFile() and resetFile() and then I call those functions at the beginning and end of my sub. I just wanted to mention that this code is helpful to turn off unnecessary features of Excel while the macro runs, which speeds up or improves the performance of the macro.
Use the code above if you want, but it is not necessary. Just a helpful tip since it is not imbedded in the main function code displayed at the end of this post.
Now, the following code is necessary because it is called in the function at end of this post (don’t give me crap for using “On Error Resume Next“):
1 2 3 4 5 6 7 8 9 | 'Returns true if worksheet exists Public Function WorksheetExists(shtName As String, Optional wb As Workbook) As Boolean Dim sht As Worksheet If wb Is Nothing Then Set wb = ThisWorkbook On Error Resume Next Set sht = wb.Sheets(shtName) On Error GoTo 0 WorksheetExists = Not sht Is Nothing End Function |
One note on using the newWorksheet function. When calling the function, there is an optional added text you can provide. This is to help differentiate the worksheet from other worksheets with a similar year and month (YYYY-MM) in their name.
Please leave any comments if you have any suggestions to improve or how you might use it in your next project. So here is the code in all it’s glory:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 | 'Create new worksheet Public Function newWorksheet(Optional addedText, Optional useDate, Optional deleteSheet, Optional askUser) As String Dim wsName As String Dim msgText As String Dim w As Integer If IsEmpty(addedText) = True And (IsEmpty(useDate) Or useData) = True Then wsName = Year(Now()) & "-" & Format(Month(Now), "00") ElseIf IsEmpty(addedText) = False And (IsEmpty(useDate) Or useDate) = True Then wsName = Year(Now()) & "-" & Format(Month(Now), "00") & " " & addedText ElseIf IsEmpty(addedText) = False And useData = False Then wsName = addedText End If 'If askUser is false, then skip the following process: If askUser <> False Then StartOver: answer = MsgBox("Would you like to name the new worksheet " & Chr(34) & wsName & Chr(34) & "?", _ vbQuestion + vbYesNo + vbDefaultButton2, "Name of new worksheet") 'If user does not select the default worksheet name, ask user to input desired worksheet name: If answer = vbNo Then w = 0 'Loop necessary to make sure user inputs a proper worksheet name Do 'If statement will only be true once on the first loop If w = 0 Then msgText = "What would you like to name the new worksheet?" & vbLf & vbLf & _ "Note: Expected format is " & Chr(34) & "YYYY-MM" & addedText & Chr(34) & vbLf If addedText Is Not Empty Then msgText = msgText & _ " " & Chr(34) & Trim(addedText) & Chr(34) & " in name is required for other macros" & vbLf End If msgText = msgText & _ " All extra space will be removed" & vbLf & _ " No special characters allowed" & vbLf & _ " Only use letters, numbers, or spaces" & vbLf & _ " Maximum of 31 characters allowed" & vbLf wsName = InputBox(addedText, "Name of new worksheet", wsName) 'If statement triggered after the first pass if true that it contains disallowed characters: ElseIf newWorksheet Like "*[!0-9A-Za-z -]*" Then wsName = InputBox("You used disallowed characters." & vbLf & _ "Only use Letters, Numbers, or Spaces." & vbLf & _ "Please rename the worksheet." & vbLf, _ "Name of new worksheet", wsName) 'If statement triggered after the first pass if true that it contains too many characters: Else wsName = InputBox("You typed in too many characters." & vbLf & _ "Maximum of 31 characters allowed!" & vbLf & _ "Please rename the worksheet." & vbLf, _ "Name of new worksheet", wsName) End If w = 1 'Checks if worksheet name has no more than 31 characters and does not contain disallowed characters 'Starts loop over if either are true Loop While Len(wsName) > 31 Or wsName Like "*[!0-9A-Za-z -]*" End If 'If user selects cancel while naming worksheet, then do the following: If StrPtr(wsName) = 0 Or wsName = "" Then answer = MsgBox("You pressed cancel. Would you like to start over?", _ vbQuestion + vbYesNo + vbDefaultButton1, _ "Error: Pressed Cancel!") 'If user answers yes, then the process starts over of asking the user about name the worksheet If answer = vbYes Then GoTo StartOver 'Exit function if user answers no Else MsgBox "You decided not to start over. Please rerun the macro." newWorksheet = "" Exit Function End If End If End If 'Trim extra space wsName = Application.Trim(wsName) 'Make sure the worksheet name does not already exist If WorksheetExists(wsName) Then If deleteSheet = True Then GoTo deleteSheetNow End If answer = MsgBox(Chr(34) & wsName & Chr(34) & " worksheet already exists. Would you like to replace it?", _ vbQuestion + vbYesNo + vbDefaultButton2, _ "Error: Worksheet Exists!") 'If user answers yes, then delete existing worksheet with same name and add new worksheet If answer = vbYes Then deleteSheetNow: Sheets(wsName).Delete Sheets.Add.Name = wsName 'Exit function if user does not want to rename worksheet Else answer = MsgBox("You pressed no. Would you like to start over and use a differenct worksheet name?", _ vbQuestion + vbYesNo + vbDefaultButton1, _ "Error: Pressed NO!") 'If user answers yes, then the process starts over of asking the user about name the worksheet If answer = vbYes Then GoTo StartOver 'Exit function if user answers no Else MsgBox "Then rename " & Chr(34) & wsName & Chr(34) & " worksheet and rerun macro." newWorksheet = "" Exit Function End If End If Else Sheets.Add.Name = wsName End If newWorksheet = wsName End Function |