Input sheetnames to include or exclude when looping through worksheets EXCEL VBA Macro

[Rowland Hamilton]

I'm cycling through multiple Excel workbooks and worksheets in a chosen folder and pulling data from the sheets.

I want to allow users to Input sheetnames to include or exclude when looping through worksheets.

How can I create an input form that will allow choices between One of 3 options for multiple inputs:
Option1 - Only include sheets with these names (Quotes around sheetname, separate multiple sheet inputs by a comma then a space
(example: "Sheet2", "Sheet6", "Sheet10"), then provide User Input box.

Option2 - Exclude sheets with these names (Quotes around sheetname, but not sure how to separate them), Then provide User Input
box.

Option3 - Act on all worksheets

Is it possible to allow for wildcards with asterices (*)? (Not sure if that works with arrays?)


How can I pass those into vba commands like these:
Example code for Option1:

'For Each Sh In Sheets(Array("Sheet2", "Sheet6", "Sheet10"))
For Each Sh In Sheets(Array(uiSheetsIncluded))

Example codes for Option2 (These I'm not sure of):

'1) If sh Not Like "Sheet1" and sh Not Like "Sheet2" Then
  If sh Not Like uiSheetsExcluded Then

'2) If sh <> "Sheet3" and sh <> "Sheet4" Then
  If sh <> uiSheetsExcluded Then

Note: If you have part of the answer, ok too. Main thing I need help with is the input method.

My current macro works for Option3 only, and will loop through and copy from all sheets in all workbooks in a specified folder as selected through a browser dialog box.

Easy to recreate work book:
The Macro button is on the Destination sheet along with column headers (Will work with any column headers)

Module01_Merge_Data

'Description: Combines all files in a folder to a master file, one worksheet.
Sub MergeFiles()
  Dim path As String, ThisWB As String, lngFilecounter As Long
  Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
  Dim Filename As String, Wkb As Workbook
  Dim CopyRng As Range, Dest As Range
  Dim RowofCopySheet As Integer
  Dim uiFirstRow As Integer
  Dim uiSheetname As String
 
  Dim lngDefFRow As Long
  Dim Response As Integer
 
  Dim sh As Worksheet
  Dim DestSh As Worksheet
  Dim Last As Long
  Dim lngLastRowcopy As Long
 
  Dim lngColTab As Long
  Dim lngLastCol As Long
  Dim uiColTab As Integer

  ' Displays a message box with the yes and no options.
  Response = MsgBox(prompt:="Do you know these?: You will be prompted for 1) First row # of data to copy (defaulted to first row under the header of this sheet), 2) Be able to browse to a folder containing ONLY the source documents, Select 'Yes' or 'No'.", Buttons:=vbYesNo)
  ' If statement to check if the yes button was selected.
  If Response = vbYes Then
 
  Else
  ' The no button was selected.
  MsgBox "You selected 'No'. Will exit Macro. Please get source data's first row #, sheet name, and be able to browse to the folder containing the documents"
  Exit Sub
  End If


  'Set default first row according to the activesheet
  lngDefFRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1
 
  'Prompt select first row of data to copy (FYI: Type 1 is a number)
  uiFirstRow = Application.InputBox("Input # of first Row of copy data under the header", "FIRST ROW UNDER HEADER", Default:=lngDefFRow, Type:=1)
  RowofCopySheet = uiFirstRow ' Row to start copying data from (below the header)in the source sheets.
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'CAPTURING SHEETNAME (TAB)
  'Set default column for captured Tab names as last column used range
  lngColTab = LastCol(ActiveSheet)
 
  'Prompt select column for captured Tab names (FYI: Type 1 is a number)
  uiColTab = Application.InputBox("Input Column # to paste captured tab names in destination sheet, 0 if you don't want to capture them", _
  "Last Column", Default:=lngColTab, Type:=1)

'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 
  ThisWB = ActiveWorkbook.Name
 
  path = GetDirectory("Select a folder containing Excel files you want to merge")
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  Set shtDest = ActiveWorkbook.ActiveSheet
  Filename = Dir(path & "\*.xls", vbNormal)
 
  If Len(Filename) = 0 Then
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  MsgBox "Cancelled folder selection, exiting Macro"
  Exit Sub
  Else
 
  'Create input box for sheetname
  'uiSheetname = Application.InputBox("Input Sheetname of Copy Data", "SHEETNAME OF COPY DATA", Default:=ActiveSheet.Name, Type:=2)
 
  Do Until Filename = vbNullString
  If Not Filename = ThisWB Then
  Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
'############################################################################################################
  For Each sh In Wkb.Worksheets
  If sh.Name <> shtDest.Name Then

  Wkb.Sheets(sh.Name).Activate
  Wkb.Sheets(sh.Name).AutoFilterMode = False
 
  '**NOTE:Usedrange can't find last row when usedrange does not begin on 1st row, so replacing this code:
  lngLastRowcopy = LastRow(sh)
  'PREV CODE: Set CopyRng = Wkb.Sheets(sh.Name).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
 
  Set CopyRng = Wkb.Sheets(sh.Name).Range(Cells(RowofCopySheet, 1), Cells(lngLastRowcopy, ActiveSheet.UsedRange.Columns.Count))
  Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
  'Find the last row with data on the ShtDest
  Last = LastRow(shtDest)
  'Test if there enough rows in the ShtDest to copy all the data
  ' If Last + CopyRng.Rows.Count > shtDest.Rows.Count Then
  '  MsgBox "There are not enough rows in the ShtDest"
  '  Exit Sub
  '  End If
 
  CopyRng.Copy
  Dest.PasteSpecial xlPasteValues
  Dest.PasteSpecial xlPasteFormats
 
'^^^^^^^^^^^^^^^^^^^^^^'Optional: This will copy the sheet name into a column in destination sheet:
  If uiColTab <> 0 Then
  shtDest.Cells(Last + 1, uiColTab).Resize(CopyRng.Rows.Count).Value = sh.Name
  'shtDest.Cells(Last + 1, "T").Resize(CopyRng.Rows.Count).Value = sh.Name 'note how can use letter for column
  Else
  End If
 
  Application.CutCopyMode = False
  End If
  Next
'############################################################################################################
  Wkb.Close False
  End If
  Filename = Dir()
  Loop
  End If
  Range("A1").Select
 
  Application.EnableEvents = True
  Application.ScreenUpdating = True
 
  MsgBox "Done!"
End Sub

Module02_File_Browser

Option Explicit
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
  Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal _
  pszpath As String) As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
  Alias "SHBrowseForFolderA" (lpBrowseInfo As BrowseInfo) _
  As Long
 
Public Type BrowseInfo
  hOwner As Long
  pIDLRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type

Function GetDirectory(Optional msg) As String
On Error Resume Next
  Dim bInfo As BrowseInfo
  Dim path As String
  Dim r As Long, x As Long, pos As Integer
 
  'Root folder = Desktop
  bInfo.pIDLRoot = 0&
 
  'Title in the dialog
  If IsMissing(msg) Then
  bInfo.lpszTitle = "No Folder Selected" & vbCrLf & vbCrLf & "Please select the folder of the excel files to copy."
  Else
  bInfo.lpszTitle = msg
  End If
 
  'Type of directory to return
  bInfo.ulFlags = &H1
 
  'Display the dialog
  x = SHBrowseForFolder(bInfo)
 
  'Parse the result
  path = Space$(512)
  r = SHGetPathFromIDList(ByVal x, ByVal path)
  If r Then
  pos = InStr(path, Chr$(0))
  GetDirectory = Left(path, pos - 1)
  Else
  GetDirectory = ""
  End If
End Function
Function LastRow(sh As Worksheet)
  On Error Resume Next
  LastRow = sh.Cells.Find(What:="*", _
  After:=sh.Range("A1"), _
  Lookat:=xlPart, _
  LookIn:=xlFormulas, _
  SearchOrder:=xlByRows, _
  SearchDirection:=xlPrevious, _
  MatchCase:=False).Row
  On Error GoTo 0
End Function

Function LastCol(sh As Worksheet)
  On Error Resume Next
  LastCol = sh.Cells.Find(What:="*", _
  After:=sh.Range("A1"), _
  Lookat:=xlPart, _
  LookIn:=xlFormulas, _
  SearchOrder:=xlByColumns, _
  SearchDirection:=xlPrevious, _
  MatchCase:=False).Column
  On Error GoTo 0
End Function

 

[Luke M]

Here's how I would do it:

Sub ExcludeSheets()
Dim myCol As Collection
Set myCol = New Collection
Dim ws As Worksheet
Dim userSH As String
Dim i As Long

'Build initial collection
For Each ws In ThisWorkbook.Worksheets
    myCol.Add ws.Name, ws.Name
Next

'Let user say which sheets to not include
Do
    userSH = ""
    userSH = InputBox("Enter the name of a sheet to exclude" & vbNewLine & "or hit cancel if all sheet names have been entered", "Exclude sheets")
   
    'In case user mis-types, or sheet doesn't exist
    On Error Resume Next
    myCol.Remove (Worksheets(userSH).Index)
    On Error GoTo 0
Loop Until userSH = ""

'Example output showing how collection has been modified
For i = 1 To myCol.Count
    MsgBox Worksheets(myCol(i)).Name
Next i

End Sub

Once you have a way to get each sheet's name, you should be able to loop over whatever other code you have/need.

 

[Rowland Hamilton]

Thanks, Luke.

I like it, tested it. Works on the active workbook and requires sheets for exclusion to be entered one at a time.

I guess it maybe possible to tweak this code so that multiple entries can be done at once? (i.e. all exclusion sheets entered in same input box, separated by a comma, But then I would have to loop through The input to remove the collected items one at a time)

I'm trying to code for multiple scenarios, including if they just want to exclude sheets with the same name in each of multiple workbooks, in which they would just select the exclusion sheets (or inclusion sheets) once, before the collections are created because it will apply to multiple workbooks.

But, for the scenario wherein I have to apply the code to multiple workbooks, excluding worksheets with very different names from workbook to workbook, then I would probably need to tweak your code or tweak this, which shows all sheets to the user:

Public strFormWS As String
'-----SNIPPET--------------------------------------------------
Sub Use_selection()
Dim wsD As Worksheet
  Call SheetActivater
  Application.ScreenUpdating = False

  If strFormWS = "" Then
  Debug.Print strFormWS
  Exit Sub
  Else
  Sheets(strFormWS).Activate
  Set wsD = ActiveSheet
  End If
End sub

'-----FULL CODE--------------------------------------------------
Sub SheetActivater()
Const ColItems  As Long = 15
Const LetterWidth As Long = 15
Const HeightRowz As Long = 18
Const SheetID As String = "__SheetSelection"
Dim i%, TopPos%, iSet%, optCols%, intLetters%, optMaxChars%, optLeft%
Dim wsDlg As DialogSheet, objOpt As OptionButton, optCaption$, objSheet As Object
optCaption = "": i = 0
  Application.ScreenUpdating = False
On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.DialogSheets(SheetID).Delete
Application.DisplayAlerts = True
Err.Clear
Set wsDlg = ActiveWorkbook.DialogSheets.Add
With wsDlg
.Name = SheetID
.Visible = xlSheetHidden
iSet = 0: optCols = 0: optMaxChars = 0: optLeft = 78: TopPos = 40
For Each objSheet In ActiveWorkbook.Sheets
If objSheet.Visible = xlSheetVisible Then
i = i + 1
If i Mod ColItems = 1 Then
optCols = optCols + 1
TopPos = 40
optLeft = optLeft + (optMaxChars * LetterWidth)
optMaxChars = 0
End If
intLetters = Len(objSheet.Name)
If intLetters > optMaxChars Then optMaxChars = intLetters
iSet = iSet + 1
.OptionButtons.Add optLeft, TopPos, intLetters * LetterWidth, 16.5
.OptionButtons(iSet).Text = objSheet.Name
TopPos = TopPos + 10
End If
Next objSheet
If i > 0 Then
  .Buttons.Left = optLeft + (optMaxChars * LetterWidth) + 2
  With .DialogFrame
  .Height = Application.Max(68, WorksheetFunction.Min(iSet, ColItems) * HeightRowz + 2)
  .Width = optLeft + (optMaxChars * LetterWidth) + 2
  .Caption = "Parse Task Number? Which Sheet?"
  End With
  .Buttons("Button 2").BringToFront
  .Buttons("Button 3").BringToFront
  If .Show = True Then
  For Each objOpt In wsDlg.OptionButtons
  If objOpt.Value = xlOn Then
  optCaption = objOpt.Caption
  Exit For
  End If
  Next objOpt
  End If
  If optCaption = "" Then
  MsgBox "You did not select a worksheet.", 48, "Cannot continue"
  Application.ScreenUpdating = True
  Exit Sub
  Else
  'MsgBox "You selected the sheet named ''" & optCaption & "''." & vbCrLf & "Click OK to go there.", 64, "FYI:"
  Sheets(optCaption).Activate
  strFormWS = optCaption
  End If
End If
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
  Application.ScreenUpdating = True
End Sub

 

[NARAYANK991]

Hi Rowland ,

See if this helps.

Narayan

 

[Rowland Hamilton]

Hi Rowland ,

See if this helps.

Narayan

Thanks, Narayan. Awesome. Looks like the simplest answer to the scenario pursued by Luke where we selected sheets to exclude, but with the expanded functionality to select all sheets or select sheets to include.

(Aside: If we added a select all and deselect all that would checked or uncheck all of the boxes, then allow users to deselect as many as they need to, that would increase the functionality a bit.)

I'll definitely adapt this approach for some workbook.

But I would need this template to work on multiple, external workbooks, so not really able to use a workbook event or open workbook macro. - Thanks, Rowland

 

[NARAYANK991]

Hi Rowland ,

I think the userform covers all of the cases you have mentioned :

When the userform is initially displayed , none of the sheet names is selected.

There are 3 option buttons , which are :

1. Include all of the selected sheets ; if this is selected , then essentially none of the sheets will be included.

2. Exclude all of the selected sheets ; if this is selected , then all of the sheets will be included.

3. Include all of the sheets in the workbook ; this can also be selected to include all the sheets in the workbook.

The only option button which has not been provided is an Exclude all the sheets in the workbook one ; if required that can also be provided.

If you want that this needs to be used on all workbooks , it is better if you put together all of the code , and then it can be made ready for use in all workbooks.

Narayan