Create Sheets From Cell Values

2 minute read

This is one of my favourites and I use it all the time. Type a bunch of sheet names in a list of cells, select those cells then run this macro.

  • Users will be prompted to select a range of cells to create sheet names
  • Error checks that the sheet name doesn’t already exist – highlights those cells Yellow
  • Error checks that the cell doesn’t contain illegal sheet name characters / * [ ] : ?
  • Error checks that the cell value doesn’t have more than the 31 character sheet name limit
  • Highlights cells red containing illegal characters or exceeding 31 characters
  • Skips cells that are blank
  • Checks if the Workbook Protection is on, notifies user and exits sub
' ======================================================================================================
'## Creates sheet names in the active workbook from selected cell value
' - Users will be prompted to select a range of cells to create sheet names
' - Error checks that the sheet name doesn't already exist - highlights those cells Yellow
' - Error checks that the cell doesn't contain illegal sheet name characters / * [ ] : ?
' - Error checks that the cell value doesn't have more than the 31 character sheet name limit
' - Highlights cells red containing illegal characters or exceeding 31 characters
' - Skips cells that are blank
' - Checks if the Workbook Protection is on, notifies user and exits sub
'=======================================================================================================
Sub AddSheetFromString() ' Vars Dim strRng As String Dim rngCell As Range Dim rngSelection As Range Dim blnError As Boolean Dim strPrompt As String ' Test a range selected If TypeName(Selection) "Range" Then Exit Sub ' Pass the selected cells address to a string strRng = ActiveWindow.RangeSelection.Address ' Briefly turn off error checking On Error Resume Next ' Pick the range using an inputbox, the initial range is the currently selected cells strPrompt = "Select cells, the values will be the new sheets names" & vbDoubleLine & _ "Any duplicates will be highlighted yellow, errors highlighted red" Set rngSelection = Application.InputBox(strPrompt, "Create Sheets", strRng, Type:=8) ' Test if clicked cancel If rngSelection Is Nothing Then Exit Sub ' Turn on error checking On Error GoTo 0 ' Optimise, turn off Screen Updating Application.ScreenUpdating = False ' Loop through each cell in the selected range For Each rngCell In rngSelection ' Test for blank cells, skip these If rngCell.Value = "" Then GoTo NextCell ' Test if any sheets are named the same as any of the cell values ' if so then paint that cell yellow and go to the next cell For Each Worksheet In ActiveWorkbook.Worksheets If rngCell = Worksheet.Name Then rngCell.Interior.Color = vbYellow GoTo NextCell End If Next Worksheet ' Test no invalid characters in folder for sheet name and that the ' character counr does not exceed the 31 sheet name character limit ' Paint the cell red and go to the next cell in the selected range If InStr(rngCell, ") > 0 Or InStr(rngCell

Leave a Comment