Kelly05201
New Member
- Joined
- Jun 17, 2016
- Messages
- 29
Hello all.. first off, confession: I'm a newbie to VBA and to MrExcel. That said, I'm working on a workbook for a horse club. My sheet 1 is "MeetSetupSettings" - info/settings about today's competition. My table lists today's events (A5:A11) and divisions chosen for each event (B5:D11).. all values are filled ("populated") from a user form and/or combo boxes (A5:D11 are all combo boxes with data validation). My OnChange VBA will monitor A5:D11 and create a new event sheet (or delete)(copied from template) to reflect the events and divisions chosen or modified.
<tbody>
</tbody>
Sheet1 Code:
Everything works perfectly about this until I start using the User Form. It's supposed to fill the values, and does nicely, EXCEPT for the mystery sheet that appears. Upon hitting the command button of the user form, the table values should be filled in(and do..), new sheets should appear (and do..), but it also it creates a sheet that shouldn't exist - one that contains ONLY the "event name" and not a concatenated division/event sheet name. (mystery sheet!)
Using sample table above, what's supposed to happen:
reset B10, C10, and B11 to empty because there's no event been selected.
For each each row: check for an event listed AND a division specified. Create sheet from template named "Youth Stakes", "Adult Stakes" and so on..
Delete sheets as necessary if an event has been eliminated.
Here's the User Form Code (oh crap, you're gonna realize what a newbie I am...)
My best guess here.. as far as why there's that mystery sheet that doesn't look like [division name] & " " & [Event Name] is that the user form is interrupting the sheet's code midstream... but it gets weirder. I close the userform, and change a value in the table, and the stray sheet won't go away. The code simply falls flat on it's face. It'll make sheets, delete sheets, but won't touch the stray sheet until I completely delete the event name (the value in column A it decided to create from). Hopefully I've provided enough comments in the code to make it self explanatory, and I REALLY hope someone has some insight on how to fix this bug!
(possible workaround: using a different event handler, like "OnUpdate" or something?)
Thanks to all in advance!
(PS, this is not a paid project... it's volunteer work for the non profit I belong to)
| A | B | C | D | |
| EVENT | ||||
| 5 | stakes | youth | adult | jack benny |
| 6 | barrel race | adult | jack benny | |
| 7 | figure 8 barrels | youth | adult | |
| 8 | keyhole | youth | ||
| 9 | ball and chain | |||
| 10 | youth | adult | ||
| 11 | adult |
<tbody>
</tbody>
Sheet1 Code:
Code:
Private Sub Worksheet_Change(ByVal target As Range)
On Error Resume Next
'this works
If Not Intersect(target, Range("A5:D11")) Is Nothing Then
Dim NotFound As Boolean
Dim EventDivision As String
Dim EventName As String
Dim NewSheetName As String
Dim ExistingSheetNameChecker As String
Dim cell As Range
Dim division As Range
Dim MaxRow As Long
Dim wksInput As Worksheet
Dim Template As Worksheet
Dim Summary As Worksheet
Dim Reg As Worksheet
Dim wks As Worksheet
Const InputName = "MeetSetupSettings"
Const TemplateName = "TET"
Const SummaryName = "Meet_Results_Summary"
Const RegName = "Registration"
Set wksInput = Worksheets(InputName)
'set event divisions to empty if no event selected for that row
For Each cell In wksInput.Range("A5:A11")
If cell.Value = "" And cell.Offset(0, 1).Value <> "" Then
cell.Offset(0, 1).Value = ""
End If
If cell.Value = "" And cell.Offset(0, 2).Value <> "" Then
cell.Offset(0, 2).Value = ""
End If
If cell.Value = "" And cell.Offset(0, 3).Value <> "" Then
cell.Offset(0, 3).Value = ""
End If
Next cell
'check for value in each column (B, C, and D), set new sheet name to create if not empty.
For Each cell In wksInput.Range("A5:A11")
'examine column B (youth division) for this row
If cell.Value <> "" And cell.Offset(0, 1).Value <> "" Then
NewSheetName = cell.Offset(0, 1).Value & " " & cell.Value:
'check for existing sheet
For Each wks In Worksheets
NotFound = True
If wks.Name Like NewSheetName Then
NotFound = False
Exit For
End If
Next wks
'else add the sheet and rename it as concatenated name
If NotFound = True Then
Worksheets(TemplateName).Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = NewSheetName
ActiveSheet.Range("B1") = "Cambridge Saddle Club - Event: " & NewSheetName
'go back to the MeetSetup sheet
Worksheets(InputName).Activate
End If
End If
'examine column C (adult division) for this row
If cell.Value <> "" And cell.Offset(0, 2).Value <> "" Then
NewSheetName = cell.Offset(0, 2).Value & " " & cell.Value:
'check for existing sheet
For Each wks In Worksheets
NotFound = True
If wks.Name Like NewSheetName Then
NotFound = False
Exit For
End If
Next wks
'else add the sheet and rename it as concatenated name
If NotFound = True Then
Worksheets(TemplateName).Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = NewSheetName
ActiveSheet.Range("B1") = "Cambridge Saddle Club - Event: " & NewSheetName
'Go back to the MeetSetup sheet
Worksheets(InputName).Activate
End If
End If
'examine column D (jack benny division)for this row
If cell.Value <> "" And cell.Offset(0, 3).Value <> "" Then
NewSheetName = cell.Offset(0, 3).Value & " " & cell.Value:
'check for existing sheet
For Each wks In Worksheets
NotFound = True
If wks.Name Like NewSheetName Then
NotFound = False
Exit For
End If
Next wks
'else add the sheet and rename it as concatenated name
If NotFound = True Then
Worksheets(TemplateName).Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = NewSheetName
ActiveSheet.Range("B1") = "Cambridge Saddle Club - Event: " & NewSheetName
'Go back to the MeetSetup sheet
Worksheets(InputName).Activate
End If
End If
Next cell
'NOW CHECK THE SHEETS THAT EXIST FOR ONES THAT DON'T MATCH THE CURRENT EVENT AGENDA
'Delete worksheets that don't match the event Names BUT IGNORE sheets named MeetSetupSettings, Template, Summary or Registration
'This might seem confusing as the sheet names are a concatenated name; column A & another column in that row.
'example: "youth" (column B) & "barrel race" (column A)
For Each wks In Worksheets
NotFound = True
ExistingSheetNameChecker = " "
'Keep Input and Template worksheets safe
If Not (wks.Name Like InputName Or wks.Name Like TemplateName Or wks.Name Like SummaryName Or wks.Name Like RegName) Then
'Check all current event names in youth division (column B) for matches
For Each cell In wksInput.Range("A5:A11")
ExistingSheetNameChecker = cell.Offset(0, 1).Value & " " & cell.Value
If wks.Name Like ExistingSheetNameChecker Then
NotFound = False
Exit For
End If
Next cell
'Check all current event names in adult division (column C) for matches
For Each cell In wksInput.Range("A5:A11")
ExistingSheetNameChecker = cell.Offset(0, 2).Value & " " & cell.Value
If wks.Name Like ExistingSheetNameChecker Then
NotFound = False
Exit For
End If
Next cell
'Check all current event names in jack benny division (column D) for matches
For Each cell In wksInput.Range("A5:A11")
ExistingSheetNameChecker = cell.Offset(0, 3).Value & " " & cell.Value
If wks.Name Like ExistingSheetNameChecker Then
NotFound = False
Exit For
End If
Next cell
Else
NotFound = False
End If
'Match was not found, delete worksheet
If NotFound Then
'Delete worksheet
Application.DisplayAlerts = False
wks.Delete
Application.DisplayAlerts = True
End If
Next wks
' "end if" below is for the OnChange event
End If
End SubEverything works perfectly about this until I start using the User Form. It's supposed to fill the values, and does nicely, EXCEPT for the mystery sheet that appears. Upon hitting the command button of the user form, the table values should be filled in(and do..), new sheets should appear (and do..), but it also it creates a sheet that shouldn't exist - one that contains ONLY the "event name" and not a concatenated division/event sheet name. (mystery sheet!)
Using sample table above, what's supposed to happen:
reset B10, C10, and B11 to empty because there's no event been selected.
For each each row: check for an event listed AND a division specified. Create sheet from template named "Youth Stakes", "Adult Stakes" and so on..
Delete sheets as necessary if an event has been eliminated.
Here's the User Form Code (oh crap, you're gonna realize what a newbie I am...)
Code:
Private Sub UserForm_Initialize()
'make fields invisible until events are selected
ComboBox6.Visible = False
ComboBox7.Visible = False
ComboBox8.Visible = False
ComboBox9.Visible = False
ComboBox10.Visible = False
ComboBox11.Visible = False
ComboBox12.Visible = False
Label6.Visible = False
Label7.Visible = False
CheckBox1.Visible = False
CheckBox2.Visible = False
CheckBox3.Visible = False
CheckBox4.Visible = False
CheckBox5.Visible = False
CheckBox6.Visible = False
CheckBox7.Visible = False
CheckBox8.Visible = False
CheckBox9.Visible = False
CheckBox10.Visible = False
CheckBox11.Visible = False
CheckBox12.Visible = False
CheckBox13.Visible = False
CheckBox14.Visible = False
CheckBox15.Visible = False
CheckBox16.Visible = False
CheckBox17.Visible = False
CheckBox18.Visible = False
CheckBox19.Visible = False
CheckBox20.Visible = False
CheckBox21.Visible = False
End Sub
Private Sub Label1_Click()
End Sub
'Hide next combobox until 1st event is chosen. Also hide checkboxes and other things until this event is chosen.
Private Sub ComboBox5_Change()
If ComboBox5.Value <> "Add An Event" Then
ComboBox6.Visible = True
Else
ComboBox6.Visible = False
End If
If ComboBox5.Value <> "Add An Event" Then
CheckBox1.Visible = True
Else
ComboBox1.Visible = False
End If
If ComboBox5.Value <> "Add An Event" Then
CheckBox8.Visible = True
Else
ComboBox8.Visible = False
End If
If ComboBox5.Value <> "Add An Event" Then
CheckBox15.Visible = True
Else
ComboBox15.Visible = False
End If
If ComboBox5.Value <> "Add An Event" Then
Label6.Visible = True
Else
Label6.Visible = False
End If
If ComboBox5.Value <> "Add An Event" Then
ComboBox12.Visible = True
Else
ComboBox12.Visible = False
End If
If ComboBox5.Value <> "Add An Event" Then
Label7.Visible = True
Else
Label7.Visible = False
End If
End Sub
'Hide next combobox until 2nd event is chosen. Also hide checkboxes until this event is chosen.
Private Sub ComboBox6_Change()
If ComboBox6.Value <> "Add An Event" Then
ComboBox7.Visible = True
Else
ComboBox7.Visible = False
End If
If ComboBox6.Value <> "Add An Event" Then
CheckBox2.Visible = True
Else
CheckBox2.Visible = False
End If
If ComboBox6.Value <> "Add An Event" Then
CheckBox9.Visible = True
Else
CheckBox9.Visible = False
End If
If ComboBox6.Value <> "Add An Event" Then
CheckBox16.Visible = True
Else
CheckBox16.Visible = False
End If
End Sub
'Hide next combobox until 3rd event is chosen. Also hide checkboxes until this event is chosen.
Private Sub ComboBox7_Change()
If ComboBox7.Value <> "Add An Event" Then
ComboBox8.Visible = True
Else
ComboBox8.Visible = False
End If
If ComboBox7.Value <> "Add An Event" Then
CheckBox3.Visible = True
Else
CheckBox3.Visible = False
End If
If ComboBox7.Value <> "Add An Event" Then
CheckBox10.Visible = True
Else
CheckBox10.Visible = False
End If
If ComboBox7.Value <> "Add An Event" Then
CheckBox17.Visible = True
Else
CheckBox17.Visible = False
End If
End Sub
'Hide next combobox until 4th event is chosen. Also hide checkboxes until this event is chosen.
Private Sub ComboBox8_Change()
If ComboBox8.Value <> "Add An Event" Then
ComboBox9.Visible = True
Else
ComboBox9.Visible = False
End If
If ComboBox8.Value <> "Add An Event" Then
CheckBox4.Visible = True
Else
CheckBox4.Visible = False
End If
If ComboBox8.Value <> "Add An Event" Then
CheckBox11.Visible = True
Else
CheckBox11.Visible = False
End If
If ComboBox8.Value <> "Add An Event" Then
CheckBox18.Visible = True
Else
CheckBox18.Visible = False
End If
End Sub
'Hide next combobox until 5th event is chosen. Also hide checkboxes until this event is chosen.
Private Sub ComboBox9_Change()
If ComboBox9.Value <> "Add An Event" Then
ComboBox10.Visible = True
Else
ComboBox10.Visible = False
End If
If ComboBox9.Value <> "Add An Event" Then
CheckBox5.Visible = True
Else
CheckBox5.Visible = False
End If
If ComboBox9.Value <> "Add An Event" Then
CheckBox12.Visible = True
Else
CheckBox12.Visible = False
End If
If ComboBox9.Value <> "Add An Event" Then
CheckBox19.Visible = True
Else
CheckBox19.Visible = False
End If
End Sub
'Hide next combobox until 6th event is chosen. Also hide checkboxes until this event is chosen.
Private Sub ComboBox10_Change()
If ComboBox10.Value <> "Add An Event" Then
ComboBox11.Visible = True
Else
ComboBox11.Visible = False
End If
If ComboBox10.Value <> "Add An Event" Then
CheckBox6.Visible = True
Else
CheckBox6.Visible = False
End If
If ComboBox10.Value <> "Add An Event" Then
CheckBox13.Visible = True
Else
CheckBox13.Visible = False
End If
If ComboBox10.Value <> "Add An Event" Then
CheckBox20.Visible = True
Else
CheckBox20.Visible = False
End If
End Sub
'Hide option buttons for event 7 until event has been selected.
Private Sub ComboBox11_Change()
If ComboBox11.Value <> "Add An Event" Then
CheckBox7.Visible = True
Else
CheckBox7.Visible = False
End If
If ComboBox11.Value <> "Add An Event" Then
CheckBox14.Visible = True
Else
CheckBox14.Visible = False
End If
If ComboBox11.Value <> "Add An Event" Then
CheckBox21.Visible = True
Else
CheckBox21.Visible = False
End If
End Sub
Private Sub TextBox2_Change()
End Sub
Private Sub CommandButton1_Click()
'check for date filled in
If Me.ComboBox1.Value = "" Then
Me.ComboBox1.SetFocus
MsgBox "Please enter the day of the event", vbOKOnly, "Required Field"
Exit Sub
End If
If Me.ComboBox2.Value = "" Then
Me.ComboBox1.SetFocus
MsgBox "Please enter the month of the event", vbOKOnly, "Required Field"
Exit Sub
End If
If Me.ComboBox3.Value = "" Then
Me.ComboBox1.SetFocus
MsgBox "Please enter the date of the event", vbOKOnly, "Required Field"
Exit Sub
End If
If Me.ComboBox4.Value = "" Then
Me.ComboBox1.SetFocus
MsgBox "Please enter the year of the event", vbOKOnly, "Required Field"
Exit Sub
End If
'submit date
Worksheets("MeetSetupSettings").Range("AG1").Value = ComboBox1.Value
Worksheets("MeetSetupSettings").Range("AG2").Value = ComboBox2.Value
Worksheets("MeetSetupSettings").Range("AG3").Value = ComboBox3.Value
Worksheets("MeetSetupSettings").Range("AG4").Value = ComboBox4.Value
'submit youth age
Worksheets("MeetSetupSettings").Range("B3").Value = ComboBox12.Value
Worksheets("MeetSetupSettings").Range("D17").Value = Fee.Value
'Copy event selections to sheet
If ComboBox5.Value <> "Add An Event" Then
Worksheets("MeetSetupSettings").Range("A5").Value = ComboBox5.Value
End If
If ComboBox6.Value <> "Add An Event" Then
Worksheets("MeetSetupSettings").Range("A6").Value = ComboBox6.Value
End If
If ComboBox7.Value <> "Add An Event" Then
Worksheets("MeetSetupSettings").Range("A7").Value = ComboBox7.Value
End If
If ComboBox8.Value <> "Add An Event" Then
Worksheets("MeetSetupSettings").Range("A8").Value = ComboBox8.Value
End If
If ComboBox9.Value <> "Add An Event" Then
Worksheets("MeetSetupSettings").Range("A9").Value = ComboBox9.Value
End If
If ComboBox10.Value <> "Add An Event" Then
Worksheets("MeetSetupSettings").Range("A10").Value = ComboBox10.Value
End If
If ComboBox11.Value <> "Add An Event" Then
Worksheets("MeetSetupSettings").Range("A11").Value = ComboBox11.Value
End If
'Copy checkbox values to sheet. Convert true and false to yes and no.
If CheckBox1.Value = "True" Then
Worksheets("MeetSetupSettings").Range("B5").Value = "YOUTH"
Else
Worksheets("MeetSetupSettings").Range("B5").Value = " "
End If
If CheckBox8.Value = "True" Then
Worksheets("MeetSetupSettings").Range("C5").Value = "ADULT"
Else
Worksheets("MeetSetupSettings").Range("C5").Value = " "
End If
If CheckBox15.Value = "True" Then
Worksheets("MeetSetupSettings").Range("D5").Value = "JACK BENNY"
Else
Worksheets("MeetSetupSettings").Range("D5").Value = " "
End If
If CheckBox2.Value = "True" Then
Worksheets("MeetSetupSettings").Range("B6").Value = "YOUTH"
Else
Worksheets("MeetSetupSettings").Range("B6").Value = " "
End If
If CheckBox9.Value = "True" Then
Worksheets("MeetSetupSettings").Range("C6").Value = "ADULT"
Else
Worksheets("MeetSetupSettings").Range("C6").Value = " "
End If
If CheckBox16.Value = "True" Then
Worksheets("MeetSetupSettings").Range("D6").Value = "JACK BENNY"
Else
Worksheets("MeetSetupSettings").Range("D6").Value = " "
End If
If CheckBox3.Value = "True" Then
Worksheets("MeetSetupSettings").Range("B7").Value = "YOUTH"
Else
Worksheets("MeetSetupSettings").Range("B7").Value = " "
End If
If CheckBox10.Value = "True" Then
Worksheets("MeetSetupSettings").Range("C7").Value = "ADULT"
Else
Worksheets("MeetSetupSettings").Range("C7").Value = " "
End If
If CheckBox17.Value = "True" Then
Worksheets("MeetSetupSettings").Range("D7").Value = "JACK BENNY"
Else
Worksheets("MeetSetupSettings").Range("D7").Value = " "
End If
If CheckBox4.Value = "True" Then
Worksheets("MeetSetupSettings").Range("B8").Value = "YOUTH"
Else
Worksheets("MeetSetupSettings").Range("B8").Value = " "
End If
If CheckBox11.Value = "True" Then
Worksheets("MeetSetupSettings").Range("C8").Value = "ADULT"
Else
Worksheets("MeetSetupSettings").Range("C8").Value = " "
End If
If CheckBox18.Value = "True" Then
Worksheets("MeetSetupSettings").Range("D8").Value = "JACK BENNY"
Else
Worksheets("MeetSetupSettings").Range("D8").Value = " "
End If
If CheckBox5.Value = "True" Then
Worksheets("MeetSetupSettings").Range("B9").Value = "YOUTH"
Else
Worksheets("MeetSetupSettings").Range("B9").Value = " "
End If
If CheckBox12.Value = "True" Then
Worksheets("MeetSetupSettings").Range("C9").Value = "ADULT"
Else
Worksheets("MeetSetupSettings").Range("C9").Value = " "
End If
If CheckBox19.Value = "True" Then
Worksheets("MeetSetupSettings").Range("D9").Value = "JACK BENNY"
Else
Worksheets("MeetSetupSettings").Range("D9").Value = " "
End If
If CheckBox6.Value = "True" Then
Worksheets("MeetSetupSettings").Range("B10").Value = "YOUTH"
Else
Worksheets("MeetSetupSettings").Range("B10").Value = " "
End If
If CheckBox13.Value = "True" Then
Worksheets("MeetSetupSettings").Range("C10").Value = "ADULT"
Else
Worksheets("MeetSetupSettings").Range("C10").Value = " "
End If
If CheckBox20.Value = "True" Then
Worksheets("MeetSetupSettings").Range("D10").Value = "JACK BENNY"
Else
Worksheets("MeetSetupSettings").Range("D10").Value = " "
End If
If CheckBox7.Value = "True" Then
Worksheets("MeetSetupSettings").Range("B11").Value = "YOUTH"
Else
Worksheets("MeetSetupSettings").Range("B11").Value = " "
End If
If CheckBox14.Value = "True" Then
Worksheets("MeetSetupSettings").Range("C11").Value = "ADULT"
Else
Worksheets("MeetSetupSettings").Range("C11").Value = " "
End If
If CheckBox21.Value = "True" Then
Worksheets("MeetSetupSettings").Range("D11").Value = "JACK BENNY"
Else
Worksheets("MeetSetupSettings").Range("D11").Value = " "
End If
'
' SaveMyWorkbook Macro
' Automatically Save As
'
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\admin\Desktop\KELLY'S CRAP\Cambridge\Autosaves\Cambridge Meet Database " & Format(Now(), "mmddyyyy") & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
'close the form.
Unload Me
End SubMy best guess here.. as far as why there's that mystery sheet that doesn't look like [division name] & " " & [Event Name] is that the user form is interrupting the sheet's code midstream... but it gets weirder. I close the userform, and change a value in the table, and the stray sheet won't go away. The code simply falls flat on it's face. It'll make sheets, delete sheets, but won't touch the stray sheet until I completely delete the event name (the value in column A it decided to create from). Hopefully I've provided enough comments in the code to make it self explanatory, and I REALLY hope someone has some insight on how to fix this bug!
(possible workaround: using a different event handler, like "OnUpdate" or something?)
Thanks to all in advance!
(PS, this is not a paid project... it's volunteer work for the non profit I belong to)
