Sub ExamScore2()
Dim Row As Integer
Dim Score As Double
Dim Award As String
'Loop through 10 rows of scores
'First column contains exam score, second to contain the award
For Row = 1 To 10
'First get the score
Score = ActiveSheet.Cells(Row, 1)
Select Case Score
Case Is < 40
Award = "Fail"
Case 40 To 59
Award = "Pass"
Case 60 To 79
Award = "Merit"
Case Else
Award = "Distinction"
End Select
'Write the award
ActiveSheet.Cells(Row, 2) = Award
Next Row
End Sub
+++++++++++++++++++++++++++
Sub ExamScore()
Dim Row As Integer
Dim Score As Double
Dim Award As String
'Loop through 10 rows of scores
'First column contains exam score, second to contain the award
For Row = 1 To 10
'First get the score
Score = ActiveSheet.Cells(Row, 1)
'Assign the award based on the score
If Score < 40 Then
Award = "Fail"
ElseIf Score < 60 Then
Award = "Pass"
ElseIf Score < 80 Then
Award = "Merit"
Else
'At this point score must be greater than 80%
Award = "Distinction"
End If
'Write the award
ActiveSheet.Cells(Row, 2) = Award
Next Row
End Sub
++++++++++++++++++++++++++++++
Private Sub CommandButton1_Click()
DinnerPlannerUserForm.Show
End Sub
------------
Private Sub UserForm_Initialize()
'Empty NameTextBox
NameTextBox.Value = ""
'Empty PhoneTextBox
PhoneTextBox.Value = ""
'Empty CityListBox
CityListBox.Clear
'Fill CityListBox
With CityListBox
.AddItem "San Fransisco"
.AddItem "Oakland"
.AddItem "Richmond"
End With
'Empty DinnerComboBox
DinnerComboBox.Clear
'Fill DinnerComboBox
With DinnerComboBox
.AddItem "Italian"
.AddItem "Chinese"
.AddItem "Frites and Meat"
End With
'Uncheck DataCheckBoxes
DateCheckBox1.Value = False
DateCheckBox2.Value = False
DateCheckBox3.Value = False
'Set no car as default
CarOptionButton2.Value = True
'Empty MoneyTextBox
MoneyTextBox.Value = ""
'Set Focus on NameTextBox
NameTextBox.SetFocus
End Sub
---------------------------------
Private Sub CancelButton_Click()
Unload Me
End Sub
Assign a macro to the Clear button
To call the Sub UserForm_Initialize when you click on the Clear button, execute the following steps.
1. Launch the Visual Basic Editor.
2. Double click on DinnerPlannerUserForm from the Project Explorer.
3. Double click on the Clear button.
4. Add the following code line:
Private Sub ClearButton_Click()
Call UserForm_Initialize
End Sub
Assign a macro to the OK button
After clicking on the OK button, the information from the Userform will be placed on your worksheet.
Private Sub OKButton_Click()
Dim emptyRow As Long
'Make Sheet1 Active
Sheets(1).Activate
'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
'Export Data to worksheet
Cells(emptyRow, 1).Value = NameTextBox.Value
Cells(emptyRow, 2).Value = PhoneTextBox.Value
Cells(emptyRow, 3).Value = CityListBox.Value
Cells(emptyRow, 4).Value = DinnerComboBox.Value
If DateCheckBox1.Value = True Then Cells(emptyRow, 5).Value = DateCheckBox1.Caption
If DateCheckBox2.Value = True Then Cells(emptyRow, 5).Value = Cells(emptyRow, 5).Value & " " & DateCheckBox2.Caption
If DateCheckBox3.Value = True Then Cells(emptyRow, 5).Value = Cells(emptyRow, 5).Value & " " & DateCheckBox3.Caption
If CarOptionButton1.Value = True Then
Cells(emptyRow, 6).Value = "Yes"
Else
Cells(emptyRow, 6).Value = "No"
End If
Cells(emptyRow, 7).Value = MoneyTextBox.Value
End Sub
--------------------------
Private Sub MoneySpinButton_Change()
MoneyTextBox.Text = MoneySpinButton.Value
End Sub
-------------------------
Private Sub ClearButton_Click()
Call UserForm_Initialize
End Sub
-----------------------
Private Sub OKButton_Click()
Dim emptyRow As Long
'Make Sheet1 Active
Sheets(1).Activate
'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
'Export Data to worksheet
Cells(emptyRow, 1).Value = NameTextBox.Value
Cells(emptyRow, 2).Value = PhoneTextBox.Value
Cells(emptyRow, 3).Value = CityListBox.Value
Cells(emptyRow, 4).Value = DinnerComboBox.Value
If DateCheckBox1.Value = True Then Cells(emptyRow, 5).Value = DateCheckBox1.Caption
If DateCheckBox2.Value = True Then Cells(emptyRow, 5).Value = Cells(emptyRow, 5).Value & " " & DateCheckBox2.Caption
If DateCheckBox3.Value = True Then Cells(emptyRow, 5).Value = Cells(emptyRow, 5).Value & " " & DateCheckBox3.Caption
If CarOptionButton1.Value = True Then
Cells(emptyRow, 6).Value = "Yes"
Else
Cells(emptyRow, 6).Value = "No"
End If
Cells(emptyRow, 7).Value = MoneyTextBox.Value
End Sub
-------------------------------
Private Sub MoneySpinButton_Change()
MoneyTextBox.Text = MoneySpinButton.Value
End Sub
No comments:
Post a Comment