Using Checkboxes in Dialog Sheet to Specify Sheets to Perform Actions

I'm currently using the following code to reset an event/inventory/sales workbook. However, I was hoping to find a way to have the user select (via dialog sheet or userform with checkboxes) which sheets need to be reset. As it is right now, when the "Create New Event" button is clicked, every sheet in the sNames array is reset, but I would like for a dialog sheet or userform to popup which would allow the user to choose which sheets would be reset (aka... which ones that array would contain). So the sheets being reset would not be fixed and/or could be different each time the "Create new event" macro is run. In other words, the remaining code would stay the same, only the sheets included in the sNames array would change.

The full code that I have right now is as follows (Please note that this currently works, but the sheets being reset are fixed and/or are always the same)

Option Explicit
Sub Create_NewEvent()

Const DBLSPACE As String = vbNewLine & vbNewLine
Const BESTNFL As String = DBLSPACE & vbNewLine & _
"The Baltimore Ravens Rule!" & _
"The Forty-Winers Do NOT"

Const openMSG As String = "After pressing OK button this " & _
 "will take some time." & DBLSPACE & "Amount of time " & _
 "depends on whether or not the Ravens have a winning record," & _
 "and whether or not..." & DBLSPACE & _
 "Just be patient! Root for the Ravens and...!" & BESTNFL

    Dim w As Long, I As Long, x As Long, sNames As Variant, invNames As     Variant, colm As Range, tbl As Range, col1 As Range, invRng As Range
Dim wb As Workbook, ws As Worksheet, fbDate As Variant, fbEvent As Variant
Set wb = ThisWorkbook



'************************************IF YOU ADD A NEW STAND SHEET, PLEASE ADD THE SHEET NAME THIS ARRAY*********************************************************
sNames = Array(Sheet1, Sheet3, Sheet5, Sheet7, Sheet9, Sheet13, _
                   Sheet17, Sheet21, Sheet23, Sheet27, Sheet31, Sheet35, _
                   Sheet39, Sheet43, Sheet47, Sheet54, Sheet56, _
                   Sheet58, Sheet60, Sheet61, Sheet62, Sheet63, Sheet64, _
                   Sheet65, Sheet82, Sheet83, Sheet84, Sheet85, Sheet90, _
                   Sheet91, Sheet93, Sheet94)
  '***************************************************************************************************************************************************************



'*************************IF YOU ADD A NEW NPO INVOICE, PLEASE ADD THE SHEET NAME & NUMBER IN THIS ARRAY********************************************************
   invNames = Array(Sheet2, Sheet4, Sheet6, Sheet8, Sheet11, Sheet15, Sheet19, Sheet25, Sheet29, Sheet33, Sheet37, _
                Sheet41, Sheet45, Sheet52, Sheet53, Sheet55, Sheet66, Sheet87)
'***************************************************************************************************************************************************************




   If MsgBox("Are you sure that you want to create a new event?", vbYesNo, "Confirm") = vbYes Then

    MsgBox openMSG

      Application.DisplayAlerts = False
      Application.ScreenUpdating = False

    For w = LBound(sNames) To UBound(sNames)
        With sNames(w)
            Debug.Print .Name

            .Range("D7:D38") = .Range("M7:M38").Value

         Set tbl = .Range("B6:P38"): Set colm = .Range("M4")

       ActiveWorkbook.Names.Add Name:="sTable", RefersTo:=tbl
       ActiveWorkbook.Names.Add Name:="col", RefersTo:=colm


        .Range("E7").Formula = "=IFERROR(IF(VLOOKUP(B7,sTable,3,FALSE)>=VLOOKUP(B7,parTable,col,FALSE),0,ROUND(SUM((VLOOKUP(B7,parTable,col,FALSE)-VLOOKUP(B7,sTable,3,FALSE))/VLOOKUP(B7,parTable,4,FALSE)),0)*VLOOKUP(B7,parTable,4,FALSE)),0)"
        .Range("E7").Copy
        .Range("E8:E38").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
           Application.CutCopyMode = False

        .Range("E7:E38").Copy
        .Range("E7:E38").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
         Application.CutCopyMode = False

        .Range("G7:M38,P43:P45").ClearContents

      ActiveWorkbook.Names("sTable").Delete
      ActiveWorkbook.Names("col").Delete


      Set tbl = Nothing: Set col1 = Nothing

    End With
Next w


For I = LBound(invNames) To UBound(invNames)
 With invNames(I)
   Debug.Print .Name
     Set invRng = .Range("B56:I56")

     .Range("E55").Value = 0

      For x = 1 To invRng.Cells.Count
       invRng.Cells(x) = ""
      Next x
    Set invRng = Nothing
  End With
Next I

 fbDate = InputBox("Please enter the new event date in the format of 2/3/2013.  This will be inserted onto the standsheets. And by the way... 2/3/2013 happens to be a past superbowl. Can you guess which one?")
 fbEvent = InputBox("Please Enter the new event name. This will be inserted into the cell provided for Event Name")

  Sheet49.Range("B3").Value = fbDate
  Sheet49.Range("B4").Value = fbEvent

   Application.DisplayAlerts = True
   Application.ScreenUpdating = True

  MsgBox "Your new event has been created... 

  End If
End Sub

Answers


Nevermind everyone.... Through a few hours of trial & error, I was able to get the following code to work perfectly... Not sure if I did this correctly (syntax, best practices, etc...), but it is definitely working exactly how I wanted it to...

Option Explicit
Sub Create_NewEvent()

 Const DBLSPACE As String = vbNewLine & vbNewLine
 Const BESTNFL As String = DBLSPACE & vbNewLine & _
"The Baltimore Ravens Rule!" & _
"The Forty-Winers Do NOT"

 Const openMSG As String = "After pressing OK button this " & _
  "will take some time." & DBLSPACE & "Amount of time " & _
  "depends on whether or not the Ravens have a winning record," & _
  "and whether or not..." & DBLSPACE & _
  "Just be patient! Root for the Ravens and...!" & BESTNFL

    Dim tPos As Integer, cb As CheckBox, SheetCount As Integer, sDlg As DialogSheet
Dim w As Long, I As Long, y As Variant, x As Long, z As Long, sNames As Variant, invNames As Variant, colm As Range, tbl As Range, col1 As Range, invRng As Range
Dim wb As Workbook, ws As Worksheet, fbDate As Variant, fbEvent As Variant
Set wb = ThisWorkbook



'************************************IF YOU ADD A NEW STAND SHEET, PLEASE ADD THE SHEET NAME THIS ARRAY*********************************************************
sNames = Array(Sheet1, Sheet3, Sheet5, Sheet7, Sheet9, Sheet13, _
                   Sheet17, Sheet21, Sheet23, Sheet27, Sheet31, Sheet35, _
                   Sheet39, Sheet43, Sheet47, Sheet54, Sheet56, _
                   Sheet58, Sheet60, Sheet61, Sheet62, Sheet63, Sheet64, _
                   Sheet65, Sheet82, Sheet83, Sheet84, Sheet85, Sheet90, _
                   Sheet91, Sheet93, Sheet94)
'***************************************************************************************************************************************************************



'*************************IF YOU ADD A NEW NPO INVOICE, PLEASE ADD THE SHEET NAME & NUMBER IN THIS ARRAY********************************************************
   invNames = Array(Sheet2, Sheet4, Sheet6, Sheet8, Sheet11, Sheet15, Sheet19, Sheet25, Sheet29, Sheet33, Sheet37, _
                Sheet41, Sheet45, Sheet52, Sheet53, Sheet55, Sheet66, Sheet87)
'***************************************************************************************************************************************************************




   If MsgBox("Are you sure that you want to create a new event?", vbYesNo, "Confirm") = vbYes Then

    MsgBox openMSG

      Application.DisplayAlerts = False
      Application.ScreenUpdating = False

  Set sDlg = ActiveWorkbook.DialogSheets.Add

SheetCount = 0


tPos = 40

  For z = LBound(sNames) To UBound(sNames)
  Set ws = sNames(z)

    If Application.CountA(ws.Cells) <> 0 Then
        SheetCount = SheetCount + 1
        sDlg.CheckBoxes.Add 78, tPos, 150, 16.5
            sDlg.CheckBoxes(SheetCount).Text = _
                ws.Name
        tPos = tPos + 13

    End If

   Set ws = Nothing
  Next z

   sDlg.Buttons.Left = 240

   With sDlg.DialogFrame
    .Height = Application.Max _
        (68, sDlg.DialogFrame.Top + tPos - 34)
    .Width = 230
    .Caption = "Select Stands to Open"
   End With


sDlg.Buttons("Button 2").BringToFront
sDlg.Buttons("Button 3").BringToFront

If SheetCount <> 0 Then
    If sDlg.Show Then
        For Each cb In sDlg.CheckBoxes
            If cb.Value = xlOn Then
             y = cb.Caption
              With Sheets(y)
               Debug.Print .Name

               .Range("D7:D38") = .Range("M7:M38").Value

               Set tbl = .Range("B6:P38"): Set colm = .Range("M4")

               wb.Names.Add Name:="sTable", RefersTo:=tbl
               wb.Names.Add Name:="col", RefersTo:=colm


        .Range("E7").Formula = "=IFERROR(IF(VLOOKUP(B7,sTable,3,FALSE)>=VLOOKUP(B7,parTable,col,FALSE),0,ROUND(SUM((VLOOKUP(B7,parTable,col,FALSE)-VLOOKUP(B7,sTable,3,FALSE))/VLOOKUP(B7,parTable,4,FALSE)),0)*VLOOKUP(B7,parTable,4,FALSE)),0)"
        .Range("E7").Copy
        .Range("E8:E38").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
           Application.CutCopyMode = False

        .Range("E7:E38").Copy
        .Range("E7:E38").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
         :=False, Transpose:=False
         Application.CutCopyMode = False

        .Range("G7:M38,P43:P45").ClearContents

      wb.Names("sTable").Delete
      wb.Names("col").Delete


      Set tbl = Nothing: Set col1 = Nothing

            End With
            End If

        Next cb
    End If
Else
    MsgBox "All worksheets are empty."
End If
 sDlg.Delete


For I = LBound(invNames) To UBound(invNames)
 With invNames(I)
   Debug.Print .Name
     Set invRng = .Range("B56:I56")

     .Range("E55").Value = 0

      For x = 1 To invRng.Cells.Count
       invRng.Cells(x) = ""
      Next x
    Set invRng = Nothing
  End With
Next I

 fbDate = InputBox("Please enter the new event date in the format of 2/3/2013.  This will be inserted onto the standsheets. And by the way... 2/3/2013 happens to be a past superbowl. Can you guess which one?")
 fbEvent = InputBox("Please Enter the new event name. This will be inserted into the cell provided for Event Name")

  Sheet49.Range("B3").Value = fbDate
  Sheet49.Range("B4").Value = fbEvent

   Application.DisplayAlerts = True
   Application.ScreenUpdating = True

  MsgBox "Your new event has been created... Don't mess anything up today Mark!  The Baltimore Ravens rule!!"

  End If
End Sub

Need Your Help

BrodcastReciver is not working

java android location broadcastreceiver

I would like to receive information in Application about Enable/Disable Location provider like NETWORK, GPS etc. I create simple BrodcastReciver:

AJAX search - parsing and reading the URL parameters with hash tags

ajax

we've implemented a new AJAX based search on our website (Example URL:

About UNIX Resources Network

Original, collect and organize Developers related documents, information and materials, contains jQuery, Html, CSS, MySQL, .NET, ASP.NET, SQL, objective-c, iPhone, Ruby on Rails, C, SQL Server, Ruby, Arrays, Regex, ASP.NET MVC, WPF, XML, Ajax, DataBase, and so on.