VBA Error Only Comments may appear after End Sub, Function or Property

excelenergy

Board Regular
Joined
Jun 7, 2012
Messages
142
Hello,

I have this code, which is producing an error that says, "Only comments may appear after End Sub, End Function, or End Property. I understand the error, but what Im unsure about is how to begin the subroutine in a way such that
1. This error goes away
2. What is the correct method name for the next subroutine
(Ie: Private Sub Declare_Variables()

Anyways, any help is appreciated, very new to this, so just a little unsure as to how to emcompass the subroutine. The error is happening in the below code at the "Public Cat1 as Variant", "Public Cat2 as Variant"


Thanks!

Rich (BB code):
Option Explicit
Private Sub cmdAdd_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("View Lessons")
'''find  first empty row in database
''iRow = ws.Cells(Rows.Count, 1) .End(xlUp).Offset(1, 0).Row
'revised code to avoid problems with Excel tables in newer versions
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
'check for a part number
If Trim(Me.txtPart.Value) = "" Then
  Me.txtPart.SetFocus
  MsgBox "Please enter an ID Number; one will be suggested…"
  txtPart.Value = Format(Application.Max(ws.Range("A:A")) + 1, "000")
  Exit Sub
End If
'copy the data to the database
ws.Cells(iRow, 1).Value = txtPart.Value
ws.Cells(iRow, 1).NumberFormat = "000"
ws.Cells(iRow, 2).Value = Me.txtLoc.Value
ws.Cells(iRow, 3).Value = Me.DTPicker1.Value
ws.Cells(iRow, 4).Value = Me.txtQty.Value
ws.Cells(iRow, 5).Value = Me.txtSdate.Value
ws.Cells(iRow, 6).Value = Me.txtldescription.Value
ws.Cells(iRow, 7).Value = Me.txtcauselesson.Value
ws.Cells(iRow, 8).Value = Me.txtlearned.Value
ws.Cells(iRow, 9).Value = Me.txtorgname.Value
ws.Cells(iRow, 10).Value = Me.txtorgemail.Value
ws.Cells(iRow, 11).Value = Me.txtorgphone.Value
ws.Cells(iRow, 12).Value = Me.txtsubname.Value
ws.Cells(iRow, 13).Value = Me.txtsubemail.Value
ws.Cells(iRow, 14).Value = Me.txtsubphone.Value
ws.Cells(iRow, 15).Value = Me.ComboBox1.Value
ws.Cells(iRow, 16).Value = Me.ListBox1.Value
ws.Cells(iRow, 17).Value = Me.txtBCat.Value
ws.Cells(iRow, 18).Value = Me.txtBSub.Value
ws.Cells(iRow, 20).Value = Me.ComboBox6.Value
ws.Cells(iRow, 29).Value = Me.txtattach.Value
ws.Cells(iRow, 30).Value = Me.txtophase.Value
ws.Cells(iRow, 31).Value = Me.txtaddition.Value
ws.Cells(iRow, 32).Value = Me.txtabc.Value
ws.Cells(iRow, 33).Value = Me.txtkeywords.Value
'clear the data
txtPart.Value = Format(Application.Max(ws.Range("A:A")) + 1, "000")
Me.txtLoc.Value = ""
Me.txtQty.Value = ""
Me.txtSdate.Value = Date
Me.txtldescription.Value = ""
Me.txtcauselesson.Value = ""
Me.txtlearned.Value = ""
Me.txtsubname.Value = ""
Me.txtsubemail.Value = ""
Me.txtsubphone.Value = ""
Me.txtorgname.Value = ""
Me.txtorgemail.Value = ""
Me.txtorgphone.Value = ""
Me.ListBox1.Value = ""
Me.txtBCat.Value = ""
Me.txtBSub.Value = ""
Me.ComboBox1.Value = ""
Me.ComboBox6.Value = ""
Me.txtattach.Value = ""
Me.txtophase.Value = ""
Me.txtaddition.Value = ""
Me.txtabc.Value = ""
Me.txtkeywords.Value = ""
Me.txtLoc.SetFocus
End Sub

Private Sub Label33_Click()
ActiveWorkbook.FollowHyperlink Address:=www.nothing.com, _
NewWindow:=True
End Sub
Private Sub UserForm_Initialize()
txtPart.Value = Format(Application.Max(Sheets("View Lessons").Range("A:A")) + 1, "000")
txtSdate.Value = Date
With Me.ComboBox7
        .AddItem "C1"
        .AddItem "C2"
        .AddItem "C3"
        .AddItem "C4"
        .AddItem "C5"
        .AddItem "C6"
    End With
With Me.ComboBox4
        .AddItem "L1"
        .AddItem "L2"
        .AddItem "L3"
        .AddItem "L4"
        .AddItem "L5"
        .AddItem "L6"
    End With
With Me.ComboBox8
        .AddItem "I"
        .AddItem "II"
        .AddItem "III"
        .AddItem "IV"
    End With
End Sub

Public Cat1 As Variant
Public Cat2 As Variant

Private Sub ComboBox7_Change()
Cat1 = Choose(Right(ComboBox7.Value, 1), "A", "B", "C", "D", "E", "F")
PopulateCombo8
End Sub
Private Sub ComboBox4_Change()
Cat2 = 7 - Right(ComboBox4.Value, 1)
PopulateCombo8
End Sub
Private Sub ComboBox8_Change()
'Red
If ComboBox8.Value = "I" Then
    With Me.ComboBox8
    .BackColor = RGB(255, 0, 0)
    End With
End If
'Orange
If ComboBox8.Value = "II" Then
    With Me.ComboBox8
    .BackColor = RGB(255, 153, 0)
    End With
End If
'Yellow
If ComboBox8.Value = "III" Then
    With Me.ComboBox8
    .BackColor = RGB(255, 255, 0)
    End With
End If
'Green
If ComboBox8.Value = "IV" Then
    With Me.ComboBox8
    .BackColor = RGB(0, 128, 0)
    End With
End If
End Sub
 
Private Sub PopulateCombo8()
Cat3Address = "$" & Cat1 & "$" & Cat2
If Cat1 <> "" And Cat2 <> "" Then
    Cat3 = Sheets("Sheet2").Range(Cat3Address).Value
End If
Me.ComboBox8.Value = Cat3
End Sub
Private Sub cmdClose_Click()
  Unload Me
End Sub
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Hey,

Fantastic thanks for the response. I did add those at the very top, but unfortunately I got a new error...

"Run-Time Error '70':
Permission Denied

Which is weird, because I googled that error and it comes when you dont have permission to change a property...(Is that correct?)...Thats a weird error this document is only stored on my computer, no where else..So not sure what the permission issue would be? any ideas?

Thanks!

These need to be at the top of the module
 
Upvote 0
Disregard, I figured it out it was with my userform_initialize, it should have been frmparts_initialize()

Now, Im having a second error, here is the new code (below) and now Im getting an error at "Private Sub PopulateComboBox8". Any thoughts? VBE is highlighting CAT3Adddress saying "variable not defined"

Rich (BB code):
Public Cat1 As Variant
Public Cat2 As Variant
Option Explicit
Private Sub cmdAdd_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("View Lessons")
'''find  first empty row in database
''iRow = ws.Cells(Rows.Count, 1) .End(xlUp).Offset(1, 0).Row
'revised code to avoid problems with Excel tables in newer versions
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
'check for a part number
If Trim(Me.txtPart.Value) = "" Then
  Me.txtPart.SetFocus
  MsgBox "Please enter an ID Number; one will be suggested…"
  txtPart.Value = Format(Application.Max(ws.Range("A:A")) + 1, "000")
  Exit Sub
End If
'copy the data to the database
ws.Cells(iRow, 1).Value = txtPart.Value
ws.Cells(iRow, 1).NumberFormat = "000"
ws.Cells(iRow, 2).Value = Me.txtLoc.Value
ws.Cells(iRow, 3).Value = Me.DTPicker1.Value
ws.Cells(iRow, 4).Value = Me.txtQty.Value
ws.Cells(iRow, 5).Value = Me.txtSdate.Value
ws.Cells(iRow, 6).Value = Me.txtldescription.Value
ws.Cells(iRow, 7).Value = Me.txtcauselesson.Value
ws.Cells(iRow, 8).Value = Me.txtlearned.Value
ws.Cells(iRow, 9).Value = Me.txtorgname.Value
ws.Cells(iRow, 10).Value = Me.txtorgemail.Value
ws.Cells(iRow, 11).Value = Me.txtorgphone.Value
ws.Cells(iRow, 12).Value = Me.txtsubname.Value
ws.Cells(iRow, 13).Value = Me.txtsubemail.Value
ws.Cells(iRow, 14).Value = Me.txtsubphone.Value
ws.Cells(iRow, 15).Value = Me.ComboBox1.Value
ws.Cells(iRow, 16).Value = Me.ListBox1.Value
ws.Cells(iRow, 17).Value = Me.txtBCat.Value
ws.Cells(iRow, 18).Value = Me.txtBSub.Value
ws.Cells(iRow, 20).Value = Me.ComboBox6.Value
ws.Cells(iRow, 29).Value = Me.txtattach.Value
ws.Cells(iRow, 30).Value = Me.txtophase.Value
ws.Cells(iRow, 31).Value = Me.txtaddition.Value
ws.Cells(iRow, 32).Value = Me.txtabc.Value
ws.Cells(iRow, 33).Value = Me.txtkeywords.Value
'clear the data
txtPart.Value = Format(Application.Max(ws.Range("A:A")) + 1, "000")
Me.txtLoc.Value = ""
Me.txtQty.Value = ""
Me.txtSdate.Value = Date
Me.txtldescription.Value = ""
Me.txtcauselesson.Value = ""
Me.txtlearned.Value = ""
Me.txtsubname.Value = ""
Me.txtsubemail.Value = ""
Me.txtsubphone.Value = ""
Me.txtorgname.Value = ""
Me.txtorgemail.Value = ""
Me.txtorgphone.Value = ""
Me.ListBox1.Value = ""
Me.txtBCat.Value = ""
Me.txtBSub.Value = ""
Me.ComboBox1.Value = ""
Me.ComboBox6.Value = ""
Me.txtattach.Value = ""
Me.txtophase.Value = ""
Me.txtaddition.Value = ""
Me.txtabc.Value = ""
Me.txtkeywords.Value = ""
Me.txtLoc.SetFocus
End Sub

Private Sub Label33_Click()
ActiveWorkbook.FollowHyperlink Address:="http://ecm/ecmlivelinkprd/llisapi.d...eb_2010_-_Rev.1.pdf?nodeid=79458399&vernum=-2", _
NewWindow:=True
End Sub
Private Sub Label35_Click()
End Sub
Private Sub txtabc_Change()
End Sub
Private Sub txtBCat_Change()
End Sub
Private Sub frmParts_Initialize()
txtPart.Value = Format(Application.Max(Sheets("View Lessons").Range("A:A")) + 1, "000")
txtSdate.Value = Date
With Me.ComboBox7
        .AddItem "C1"
        .AddItem "C2"
        .AddItem "C3"
        .AddItem "C4"
        .AddItem "C5"
        .AddItem "C6"
    End With
With Me.ComboBox4
        .AddItem "L1"
        .AddItem "L2"
        .AddItem "L3"
        .AddItem "L4"
        .AddItem "L5"
        .AddItem "L6"
    End With
With Me.ComboBox8
        .AddItem "I"
        .AddItem "II"
        .AddItem "III"
        .AddItem "IV"
    End With
End Sub

Private Sub ComboBox7_Change()
Cat1 = Choose(Right(ComboBox7.Value, 1), "A", "B", "C", "D", "E", "F")
PopulateCombo8
End Sub
Private Sub ComboBox4_Change()
Cat2 = 7 - Right(ComboBox4.Value, 1)
PopulateCombo8
End Sub
Private Sub ComboBox8_Change()
'Red
If ComboBox8.Value = "I" Then
    With Me.ComboBox8
    .BackColor = RGB(255, 0, 0)
    End With
End If
'Orange
If ComboBox8.Value = "II" Then
    With Me.ComboBox8
    .BackColor = RGB(255, 153, 0)
    End With
End If
'Yellow
If ComboBox8.Value = "III" Then
    With Me.ComboBox8
    .BackColor = RGB(255, 255, 0)
    End With
End If
'Green
If ComboBox8.Value = "IV" Then
    With Me.ComboBox8
    .BackColor = RGB(0, 128, 0)
    End With
End If
End Sub
 
Private Sub PopulateCombo8()
Cat3Address = "$" & Cat1 & "$" & Cat2
If Cat1 <> "" And Cat2 <> "" Then
    Cat3 = Sheets("Sheet2").Range(Cat3Address).Value
End If
Me.ComboBox8.Value = Cat3
End Sub
Private Sub cmdClose_Click()
  Unload Me
End Sub
 
Private Sub Label2_Click()
End Sub
Private Sub txtlast_Change()
End Sub
Private Sub txtldescription_Change()
End Sub

These need to be at the top of the module
 
Upvote 0
Disregard, I figured it out it was with my userform_initialize, it should have been frmparts_initialize()

Now, Im having a second error, here is the new code (below) and now Im getting an error at "Private Sub PopulateComboBox8". Any thoughts? VBE is highlighting CAT3Adddress saying "variable not defined"

Rich (BB code):
Public Cat1 As Variant
Public Cat2 As Variant
Option Explicit
Private Sub cmdAdd_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("View Lessons")
'''find  first empty row in database
''iRow = ws.Cells(Rows.Count, 1) .End(xlUp).Offset(1, 0).Row
'revised code to avoid problems with Excel tables in newer versions
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
'check for a part number
If Trim(Me.txtPart.Value) = "" Then
  Me.txtPart.SetFocus
  MsgBox "Please enter an ID Number; one will be suggested…"
  txtPart.Value = Format(Application.Max(ws.Range("A:A")) + 1, "000")
  Exit Sub
End If
'copy the data to the database
ws.Cells(iRow, 1).Value = txtPart.Value
ws.Cells(iRow, 1).NumberFormat = "000"
ws.Cells(iRow, 2).Value = Me.txtLoc.Value
ws.Cells(iRow, 3).Value = Me.DTPicker1.Value
ws.Cells(iRow, 4).Value = Me.txtQty.Value
ws.Cells(iRow, 5).Value = Me.txtSdate.Value
ws.Cells(iRow, 6).Value = Me.txtldescription.Value
ws.Cells(iRow, 7).Value = Me.txtcauselesson.Value
ws.Cells(iRow, 8).Value = Me.txtlearned.Value
ws.Cells(iRow, 9).Value = Me.txtorgname.Value
ws.Cells(iRow, 10).Value = Me.txtorgemail.Value
ws.Cells(iRow, 11).Value = Me.txtorgphone.Value
ws.Cells(iRow, 12).Value = Me.txtsubname.Value
ws.Cells(iRow, 13).Value = Me.txtsubemail.Value
ws.Cells(iRow, 14).Value = Me.txtsubphone.Value
ws.Cells(iRow, 15).Value = Me.ComboBox1.Value
ws.Cells(iRow, 16).Value = Me.ListBox1.Value
ws.Cells(iRow, 17).Value = Me.txtBCat.Value
ws.Cells(iRow, 18).Value = Me.txtBSub.Value
ws.Cells(iRow, 20).Value = Me.ComboBox6.Value
ws.Cells(iRow, 29).Value = Me.txtattach.Value
ws.Cells(iRow, 30).Value = Me.txtophase.Value
ws.Cells(iRow, 31).Value = Me.txtaddition.Value
ws.Cells(iRow, 32).Value = Me.txtabc.Value
ws.Cells(iRow, 33).Value = Me.txtkeywords.Value
'clear the data
txtPart.Value = Format(Application.Max(ws.Range("A:A")) + 1, "000")
Me.txtLoc.Value = ""
Me.txtQty.Value = ""
Me.txtSdate.Value = Date
Me.txtldescription.Value = ""
Me.txtcauselesson.Value = ""
Me.txtlearned.Value = ""
Me.txtsubname.Value = ""
Me.txtsubemail.Value = ""
Me.txtsubphone.Value = ""
Me.txtorgname.Value = ""
Me.txtorgemail.Value = ""
Me.txtorgphone.Value = ""
Me.ListBox1.Value = ""
Me.txtBCat.Value = ""
Me.txtBSub.Value = ""
Me.ComboBox1.Value = ""
Me.ComboBox6.Value = ""
Me.txtattach.Value = ""
Me.txtophase.Value = ""
Me.txtaddition.Value = ""
Me.txtabc.Value = ""
Me.txtkeywords.Value = ""
Me.txtLoc.SetFocus
End Sub

Private Sub Label33_Click()
ActiveWorkbook.FollowHyperlink Address:="http://ecm/ecmlivelinkprd/llisapi.d...eb_2010_-_Rev.1.pdf?nodeid=79458399&vernum=-2", _
NewWindow:=True
End Sub
Private Sub Label35_Click()
End Sub
Private Sub txtabc_Change()
End Sub
Private Sub txtBCat_Change()
End Sub
Private Sub frmParts_Initialize()
txtPart.Value = Format(Application.Max(Sheets("View Lessons").Range("A:A")) + 1, "000")
txtSdate.Value = Date
With Me.ComboBox7
        .AddItem "C1"
        .AddItem "C2"
        .AddItem "C3"
        .AddItem "C4"
        .AddItem "C5"
        .AddItem "C6"
    End With
With Me.ComboBox4
        .AddItem "L1"
        .AddItem "L2"
        .AddItem "L3"
        .AddItem "L4"
        .AddItem "L5"
        .AddItem "L6"
    End With
With Me.ComboBox8
        .AddItem "I"
        .AddItem "II"
        .AddItem "III"
        .AddItem "IV"
    End With
End Sub

Private Sub ComboBox7_Change()
Cat1 = Choose(Right(ComboBox7.Value, 1), "A", "B", "C", "D", "E", "F")
PopulateCombo8
End Sub
Private Sub ComboBox4_Change()
Cat2 = 7 - Right(ComboBox4.Value, 1)
PopulateCombo8
End Sub
Private Sub ComboBox8_Change()
'Red
If ComboBox8.Value = "I" Then
    With Me.ComboBox8
    .BackColor = RGB(255, 0, 0)
    End With
End If
'Orange
If ComboBox8.Value = "II" Then
    With Me.ComboBox8
    .BackColor = RGB(255, 153, 0)
    End With
End If
'Yellow
If ComboBox8.Value = "III" Then
    With Me.ComboBox8
    .BackColor = RGB(255, 255, 0)
    End With
End If
'Green
If ComboBox8.Value = "IV" Then
    With Me.ComboBox8
    .BackColor = RGB(0, 128, 0)
    End With
End If
End Sub
 
Private Sub PopulateCombo8()
Cat3Address = "$" & Cat1 & "$" & Cat2
If Cat1 <> "" And Cat2 <> "" Then
    Cat3 = Sheets("Sheet2").Range(Cat3Address).Value
End If
Me.ComboBox8.Value = Cat3
End Sub
Private Sub cmdClose_Click()
  Unload Me
End Sub
 
Private Sub Label2_Click()
End Sub
Private Sub txtlast_Change()
End Sub
Private Sub txtldescription_Change()
End Sub

Disregard.
 
Upvote 0

Forum statistics

Threads
1,214,515
Messages
6,119,974
Members
448,934
Latest member
audette89

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top