VBA outputting option buttons

KKarol2573

New Member
Joined
May 10, 2016
Messages
2
I have posted this on stack overflow so if anythig on here doesnt make sense or the way it looks is confusing then the link is here:

excel - VBA output in regards to option buttons - Stack Overflow

Im an A-Level student studying computer science and as part of my course i have to create a program. My program is VBA based and what it is meant to do is output details from userforms into my spreadsheet:


[Spreadsheet and the way it looks][1]




I have created these 3 userforms:

imgur.com/ftqfEBt - Userform 1
imgur.com/pT2WHuD - Userform 2
imgur.com/BHHGOPv - Userform 3


What the program is meant to do is output all the details from the userforms into specific sections of the spreadsheet. The problem that i am getting is with userform 3 and the problem is that my code doesnt want to output into the spreadsheet. In order to explain what i mean i am going to put the code for all userforms below:


Userform 1


Private Sub Forename_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Set available characters to A-Z only
If (KeyAscii < 65 Or KeyAscii > 90) And (KeyAscii < 97 Or KeyAscii > 122) Then KeyAscii = 0


End Sub


Private Sub Surname_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Set available characters to A-Z only
If (KeyAscii < 65 Or KeyAscii > 90) And (KeyAscii < 97 Or KeyAscii > 122) Then KeyAscii = 0


End Sub


Private Sub School_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Set available characters to A-Z only
If (KeyAscii < 65 Or KeyAscii > 90) And (KeyAscii < 97 Or KeyAscii > 122) Then KeyAscii = 0


End Sub


Private Sub Candidate_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Set available characters to 0-9 only
Select Case KeyAscii
Case vbKey0 To vbKey9, vbKeyBack, vbKeyClear, vbKeyLeft, _
vbKeyRight, vbKeyUp, vbKeyDown, vbKeyTab
Case Else
KeyAscii = 0
Beep
End Select


End Sub


Private Sub Closing_Click()
'Close the UserForm
Unload Me


End Sub


Private Sub Reset_Click()
'Clear all fields
Call UserForm_Initialize


End Sub


Sub ValidtyCheck()


'Check if all data is entered correctly


If Forename.Value = "" Then
Me.Forename.SetFocus
MsgBox "The Forename is Missing" 'Validation Check - Makes sure the Value is not empty
End If


If Surname.Value = "" Then
Me.Surname.SetFocus
MsgBox "The Surnamee is Missing" 'Validation Check - Makes sure the Value is not empty
End If


If School.Value = "" Then
Me.School.SetFocus
MsgBox "The School you previously attended to is Missing" 'Validation Check - Makes sure the Value is not empty
End If


If Candidate.Value = "" Then
Me.Candidate.SetFocus
MsgBox "The Candidate number is Missing" 'Validation Check - Makes sure the Value is not empty
End If


If IsNumeric(Candidate.Value) = False Then
MsgBox "Candidate number contains characters other than numbers" 'Validation Check - makes sure only numbers are entered
End If

If Trim(Me.Candidate.TextLength > 4) Then
Me.Candidate.SetFocus
MsgBox ("Candidate Number Contains more than 4 characters") 'Validation Check - Makes sure that no more than 4 characters are entered
End If


If Trim(Me.Candidate.TextLength < 4) Then
Me.Candidate.SetFocus
MsgBox ("Candidate Number Contains less than 4 characters") 'Validation Check - Makes sure that no less than 4 characters are entered
End If


End Sub


Sub Main()
On Error GoTo NoBlanks
Range("A1:A9000").SpecialCells(xlCellTypeBlanks).Value = "N/A"


NoBlanks:
Resume Next
' or add code here to execute when there are no empty cells
End Sub


Sub RemoveBlankRows()


'Deletes any row with blank cells located inside a designated range


On Error Resume Next


Dim rng As Range


Set rng = Range("A5:A9000").SpecialCells(xlCellTypeBlanks)
rng.EntireRow.Delete


End Sub


Sub InputDetails()


'Input details into specific cells


Set ws = Sheets("Details")
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Forename.Value
Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = Surname.Value
Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = School.Value
Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = Candidate.Value


End Sub


Private Sub Submit_Click()


'Output all information into the spreadsheet


Call ValidtyCheck
Call RemoveBlankRows
Call InputDetails


Unload Me


'opens 2nd userform
GCSEsTaken.Show


End Sub


Private Sub UserForm_Initialize()
'Empty ForenameTextBox
Forename.Value = ""


'Clear SurnameTextBox
Surname.Value = ""


'Clear SchoolTextBox
School.Value = ""


'Clear CandidateTextBox
Candidate.Value = ""


'Set Focus on ForenameTextBox
Forename.SetFocus


End Sub


That is all the code for the whole of Userofrm 1 please do not judge me by the way i laid it out or anything like that i know i am posting a lot of code but thats because i need to in order to show what is exactly wrong with it


Userform 2


Private Sub Closing_Click()
'Close the UserForm
Unload Me


End Sub


Private Sub Reset_Click()
'Clear all fields
Call UserForm_Initialize


End Sub


Private Sub GCSEsTaken_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Set available characters to 0-9 only
Select Case KeyAscii
Case vbKey0 To vbKey9, vbKeyBack, vbKeyClear, vbKeyLeft, _
vbKeyRight, vbKeyUp, vbKeyDown, vbKeyTab
Case Else
KeyAscii = 0
Beep
End Select


End Sub


Sub InputDetails()


'Input details into specific cells


Range("A" & Rows.Count).End(xlUp).Offset(0, 5).Value = GCSEsTaken.Value


End Sub


Private Sub Submit_Click()


Call InputDetails


Unload Me


'opens 2nd userform
GCSE.Show




End Sub


Private Sub UserForm_Initialize()


'Empty GCSE's Taken TextBox
GCSEsTaken.Value = ""


End Sub


The next piece of code is for Userform 3 and it is what is going wrong the stuff that are going wrong are within InputDetails() Sub. Plus if you have any idea i can shorten the OptionsValues () Sub then please do


Private Sub Closing_Click()
'Close the UserForm
Unload Me


End Sub






Private Sub Reset_Click()
'Clear all fields
Call UserForm_Initialize


End Sub


Private Sub OptionsValues()


MathsAx.Value = "A*"
MathsA.Value = "A"
MathsB.Value = "B"
MathsC.Value = "C"
MathsD.Value = "D"
MathsE.Value = "E"
MathsF.Value = "F"


EnglishLangAx.Value = "A*"
EnglishLangA.Value = "A"
EnglishLangB.Value = "B"
EnglishLangC.Value = "C"
EnglishLangD.Value = "D"
EnglishLangE.Value = "E"
EnglishLangF.Value = "F"
EnglishLangU.Value = "U"


EnglishLitAx.Value = "A*"
EnglishLitA.Value = "A"
EnglishLitB.Value = "B"
EnglishLitC.Value = "C"
EnglishLitD.Value = "D"
EnglishLitE.Value = "E"
EnglishLitF.Value = "F"
EnglishLitU.Value = "U"


SingSienceAx.Value = "A*"
SingSienceA.Value = "A"
SingSienceB.Value = "B"
SingSienceC.Value = "C"
SingSienceD.Value = "D"
SingSienceE.Value = "E"
SingSienceF.Value = "F"
SingSienceU.Value = "U"


DouScienceAx.Value = "A*"
DouScienceA.Value = "A"
DouScienceB.Value = "B"
DouScienceC.Value = "C"
DouScienceD.Value = "D"
DouScienceE.Value = "E"
DouScienceF.Value = "F"
DouScienceU.Value = "U"


TriScienceAx.Value = "A*"
TriScienceA.Value = "A"
TriScienceB.Value = "B"
TriScienceC.Value = "C"
TriScienceD.Value = "D"
TriScienceE.Value = "E"
TriScienceF.Value = "F"
TriScienceU.Value = "U"


REAx.Value = "A*"
REA.Value = "A"
REB.Value = "B"
REC.Value = "C"
RED.Value = "D"
REE.Value = "E"
REF.Value = "F"
REU.Value = "U"


ICTAx.Value = "A*"
ICTA.Value = "A"
ICTB.Value = "B"
ICTC.Value = "C"
ICTD.Value = "D"
ICTE.Value = "E"
ICTF.Value = "F"
ICTU.Value = "U"


DAndTAx.Value = "A*"
DAndTA.Value = "A"
DAndTB.Value = "B"
DAndTC.Value = "C"
DAndTD.Value = "D"
DAndTE.Value = "E"
DAndTF.Value = "F"
DAndTU.Value = "U"


HistoryAx.Value = "A*"
HistoryA.Value = "A"
HistoryB.Value = "B"
HistoryC.Value = "C"
HistoryD.Value = "D"
HistoryE.Value = "E"
HistoryF.Value = "F"
HistoryU.Value = "U"


GeographyAx.Value = "A*"
GeographyA.Value = "A"
GeographyB.Value = "B"
GeographyC.Value = "C"
GeographyD.Value = "D"
GeographyE.Value = "E"
GeographyF.Value = "F"
GeographyU.Value = "U"


MusicAx.Value = "A*"
MusicA.Value = "A"
MusicB.Value = "B"
MusicC.Value = "C"
MusicD.Value = "D"
MusicE.Value = "E"
MusicF.Value = "F"
MusicU.Value = "U"


DramaAx.Value = "A*"
DramaA.Value = "A"
DramaB.Value = "B"
DramaC.Value = "C"
DramaD.Value = "D"
DramaE.Value = "E"
DramaF.Value = "F"
DramaU.Value = "U"


SociologyAx.Value = "A*"
SociologyA.Value = "A"
SociologyB.Value = "B"
SociologyC.Value = "C"
SociologyD.Value = "D"
SociologyE.Value = "E"
SociologyF.Value = "F"
SociologyU.Value = "U"


PsychologyAx.Value = "A*"
PsychologyA.Value = "A"
PsychologyB.Value = "B"
PsychologyC.Value = "C"
PsychologyD.Value = "D"
PsychologyE.Value = "E"
PsychologyF.Value = "F"
PsychologyU.Value = "U"


EconomicsAx.Value = "A*"
EconomicsA.Value = "A"
EconomicsB.Value = "B"
EconomicsC.Value = "C"
EconomicsD.Value = "D"
EconomicsE.Value = "E"
EconomicsF.Value = "F"
EconomicsU.Value = "U"


FrenchAx.Value = "A*"
FrenchA.Value = "A"
FrenchB.Value = "B"
FrenchC.Value = "C"
FrenchD.Value = "D"
FrenchE.Value = "E"
FrenchF.Value = "F"
FrenchU.Value = "U"


SpanishAx.Value = "A*"
SpanishA.Value = "A"
SpanishB.Value = "B"
SpanishC.Value = "C"
SpanishD.Value = "D"
SpanishE.Value = "E"
SpanishF.Value = "F"
SpanishU.Value = "U"


ArabicAx.Value = "A*"
ArabicA.Value = "A"
ArabicB.Value = "B"
ArabicC.Value = "C"
ArabicD.Value = "D"
ArabicE.Value = "E"
ArabicF.Value = "F"
ArabicU.Value = "U"


PEAx.Value = "A*"
PEA.Value = "A"
PEB.Value = "B"
PEC.Value = "C"
PED.Value = "D"
PEE.Value = "E"
PEF.Value = "F"
PEU.Value = "U"




End Sub


Sub InputDetails()


'Input details into specific cells


If MathsAx.Value = True Then
Range("A" & Rows.Count).End(xlUp).Offset(0, 6).Value = MathsAx.Value
'THIS IS JUST A CODE TEST HENCE WHY MOST QUOTED OUT I DONT KNOW BUT IT DOESNT GIVE ANY VALUES IN THE SPREADHSEET
'Else
' Cells(emptyRow, 6).Value = "No"
End If
'THIS CODE SEEMS TO WORK FOR THE PREVIOUS USERFORMS BUT THIS ONE IT DOESNT WORK AT ALL AND I DONT KNOW WHY
'Range("A" & Rows.Count).End(xlUp).Offset(0, 6).Value = Frame1.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 7).Value = Frame2.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 8).Value = Frame3.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 9).Value = Frame4.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 10).Value = Frame5.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 11).Value = Frame6.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 12).Value = Frame7.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 13).Value = Frame8.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 14).Value = Frame9.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 15).Value = Frame10.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 16).Value = Frame11.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 17).Value = Frame12.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 18).Value = Frame13.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 19).Value = Frame14.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 20).Value = Frame15.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 21).Value = Frame16.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 22).Value = Frame17.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 23).Value = Frame18.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 24).Value = Frame19.Value
'Range("A" & Rows.Count).End(xlUp).Offset(0, 25).Value = Frame20.Value


'Range("A" & Rows.Count).End(xlUp).Offset(0, 26).Value = Other.Value




End Sub


Private Sub Submit_Click()


Call OptionsValues
Call InputDetails


Unload Me






End Sub


Private Sub UserForm_Initialize()




'Empty Other TextBox
Other.Value = ""




Dim ctlX As MSForms.Control

For Each ctlX In Frame1.Controls
If TypeOf ctlX Is MSForms.OptionButton Then
If ctlX.Value Then
ctlX.Value = False
Exit For
End If
End If
Next


End Sub


So yeah i know i posted a lot of code but its just that the code flows between eachother and i dont understand why userform 3 doesnt give any details whatsoever. Please help me i need it ASAP since this is due this week. All help appreciated.


[1]: Imgur: The most awesome images on the Internet
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Frames don''t have a value property.... so anything that resembles this will not work:

Code:
[COLOR=#333333]Range("A" & Rows.Count).End(xlUp).Offset(0, 25).Value = Frame20.Value[/COLOR]
 
Upvote 0
Frames don''t have a value property.... so anything that resembles this will not work:

Code:
[COLOR=#333333]Range("A" & Rows.Count).End(xlUp).Offset(0, 25).Value = Frame20.Value[/COLOR]

Thanks, I ended up just using IF statements like this

If MathsAx.Value = True Then
Range("A" & Rows.Count).End(xlUp).Offset(0, 6).Value = "A*"
End If

One question though

In my Userof0rm Initialize, i have code that removes all option button selections so that if someone presses reset it runs userform initialize and the code looks like this

Dim ctlX As MSForms.Control

For Each ctlX In Frame1.Controls
If TypeOf ctlX Is MSForms.OptionButton Then
If ctlX.Value Then
ctlX.Value = False
Exit For
End If
End If
Next


For Each ctlX In Frame2.Controls
If TypeOf ctlX Is MSForms.OptionButton Then
If ctlX.Value Then
ctlX.Value = False
Exit For
End If
End If
Next

and so on for 20 frames. So my questions is if its possible to generalise it for all frames within the userform rather than have the same code 20 times in a row
 
Upvote 0
Try this:

Code:
[COLOR=#0000ff]Private Sub [/COLOR]CommandButton1_Click()
[COLOR=#0000ff]
[/COLOR]
[COLOR=#0000ff]    Dim [/COLOR]cCont[COLOR=#0000ff] As [/COLOR]Control


 [COLOR=#0000ff]   For Each [/COLOR]cCont [COLOR=#0000ff]In [/COLOR]Me.Controls
      [COLOR=#0000ff]  If [/COLOR]TypeName(cCont) = "OptionButton" [COLOR=#0000ff]Then[/COLOR]


            cCont.Value = False


[COLOR=#0000ff]        End If[/COLOR]
 [COLOR=#0000ff]    Next[/COLOR] cCont


[COLOR=#0000ff]End Sub[/COLOR]
 
Upvote 0

Forum statistics

Threads
1,215,495
Messages
6,125,149
Members
449,208
Latest member
emmac

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