Function To Get The Selected Sheet Names With Examples

3 minute read

Function to get the selected sheet names with examples.

  1. Create a string from sheet names separates by a forward slash – “/” this character is not allowed to be used in a sheet name.
  2. Use this with the ExtractWord function to get a list of the selected sheets in the active workbook.
  3. Then iterate through each selected sheet and copy to a new workbook.

Looping through each sheet means you can test for any protected sheets in the selection. The most popular use of copying to another workbook is ‘ActiveWindow.SelectedSheets.Copy’ however this an error if any of the selected sheets contains a table.

'==========================================================================================================
' ## Function: create a string from sheet names separates by a forward slash - "/"
' as this character is not allowed to be used in a sheet name. Use this with the
' ExtractWord function to get a list of the selected sheets in the active workbook.
' Then iterate through each selected sheet and copy to a new workbook. This way you
' can test for any protected sheets in the selection. The most popular use of copying
' sheets to another workbook is 'ActiveWindow.SelectedSheets.Copy' however this
' throws an error if any of the selected sheets contains a table.
'==========================================================================================================
Function SelectedSheetNames() ' Vars Dim SheetList As String Dim shtName As Worksheet ' Create a string with sheets joined For Each shtName In ActiveWindow.SelectedSheets SheetList = SheetList & shtName.Name & "/" Next shtName ' Output the list and take off the last forward slash SelectedSheetNames = Left(SheetList, Len(SheetList) - 1)
End Function
'==========================================================================================================
' # Test the 'Selected Sheet Names' Function
Sub ListSelectedSheets() MsgBox SelectedSheetNames
End Sub
'==========================================================================================================
' # Loop through each selected sheet
Sub LoopSelectedSheetsExample1() ' Vars Dim i As Long Dim arr() As String ' Loop through each selected sheet and msgbox each sheet name For i = 0 To ActiveWindow.SelectedSheets.Count - 1 arr = VBA.Split(SelectedSheetNames, "/") MsgBox arr(i) Next
End Sub
'==========================================================================================================
' # Same as example 1 but using the ExtractWord function
Sub LoopSelectedSheetsExample2() ' Vars Dim i As Long Dim arr() As String ' Loop through each selected sheet and msgbox each sheet name For i = 1 To ActiveWindow.SelectedSheets.Count MsgBox ExtractWord(SelectedSheetNames, i) Next
End Sub
'==========================================================================================================
' # Loop through each selected sheet and rename them
Sub LoopSelectedSheetsExample3() ' Vars Dim i As Long Dim SelectedCount As Long Dim SheetNames As String ' Optimise Application.ScreenUpdating = False ' Get count of selected sheets as will have to deselect before copying ' If count is 1 then rename this one then exit SelectedCount = ActiveWindow.SelectedSheets.Count If SelectedCount = 1 Then ActiveSheet.Name = "RenamedSheet-1" Exit Sub End If ' Get the list of sheet names SheetNames = SelectedSheetNames ' Select only the active sheet ActiveSheet.Select ' Loop through each selected sheet and copy to a new workbook For i = 1 To SelectedCount Sheets(ExtractWord(SheetNames, i)).Name = "RenamedSheet-" & i Next ' Optimise Application.ScreenUpdating = True
End Sub
'==========================================================================================================
' # Loop through each selected sheet and copy to new workbook
Sub LoopSelectedSheetsExample4() ' Vars Dim i As Long Dim SelectedCount As Long Dim SheetNames As String Dim wbOriginal As Workbook Dim wbNew As Workbook ' Optimise Application.ScreenUpdating = False ' Get count of selected sheets as will have to deselect before copying ' If count is 1 then copy this one then exit SelectedCount = ActiveWindow.SelectedSheets.Count If SelectedCount = 1 Then ActiveWorkbook.ActiveSheet.Copy Set wbNew = ActiveWorkbook Exit Sub End If Set wbOriginal = ActiveWorkbook ' Get the list of sheet names SheetNames = SelectedSheetNames ' Select only the active sheet ActiveSheet.Select ' Loop through each selected sheet and copy to a new workbook For i = 1 To SelectedCount If i = 1 Then wbOriginal.Sheets(ExtractWord(SheetNames, i)).Copy Set wbNew = ActiveWorkbook Else wbOriginal.Sheets(ExtractWord(SheetNames, i)).Copy After:=wbNew.Sheets(Sheets.Count) End If Next ' Optimise Application.ScreenUpdating = True
End Sub

Tags: developer, function, validation

Categories: vba

Updated: November 16, 2018

Twitter Facebook LinkedIn

Leave a Comment