Tuesday, February 22, 2011

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