Using VBA, create a sub. Please also print screen the code so I know easier to r

Question

Using VBA, create a sub. Please also print screen the code so I know easier to read intention.

Worksheet 'Data' contains information about some US colleges and their college football rankings.
Answer Question based on the data. (See additional hints and details comments in the VBA code.)

The goal of this homework is to test the use of conditional statements, loops, MessageBox, and (possibly) arrays).

Go through the list again, and calculate the 'Rouge-Ranking' as follows:
    '18-Century' schools, the rouge-ranking is: (Enrollment / AlphaOrder) * 0.52    (Note: '/' is a Division sign).
    '19-Century' schools, the rouge-ranking is: (Enrollment / AlphaOrder) * 0.45    (Note: '/' is a Division sign).
    '20-Century' schools, the rouge-ranking is: (Enrollment / AlphaOrder) * 0.38    (Note: '/' is a Division sign).

Update the 'Rouge-ranking' (column K) with the values calculated, rounded to the nearest integer.

My professor provided the following framework, so please try to follow his framework.

Sub UpdateRougeRanking()
' This subroutine should:
'Compute the 'Rouge Range'
'Update the 'Rouge_Range' column with the computed value.

  
With Worksheet("Data").Range("A1")
'For each row:
' Compute Rouge-Ranking
' Update Rouge-ranking column.

End With
  
End Sub

https://drive.google.com/drive/folders/0BxP4yzZKjlvySjBlbURwVzItMjA?usp=sharing # I also uploaded the file to my google drive.

Go through the list again, and calculate the 'Rouge-Ranking' as follows:
    '18-Century' schools, the rouge-ranking is: (Enrollment / AlphaOrder) * 0.52    (Note: '/' is a Division sign).
    '19-Century' schools, the rouge-ranking is: (Enrollment / AlphaOrder) * 0.45    (Note: '/' is a Division sign).
    '20-Century' schools, the rouge-ranking is: (Enrollment / AlphaOrder) * 0.38    (Note: '/' is a Division sign).

Update the 'Rouge-ranking' (column K) with the values calculated, rounded to the nearest integer.

Record Macro Import Export Map Properties View Code Expansion Packs E! Refresh Data Visual Macros Add- Excel COM Insert Design ins Add-ins Add-ins Mode Macro Security n Dialog Code Add-ins 1 AlphaOrder City St Founded " Enrollment 1870 1878 1877 1942 1841 1789 Rouge-Rankin Name Canisius Creighton Detroit Mercy http://www.canisius.edu Buffalo https://www.creighton.edOmaha http://www.udmercy.edu Detroit https://www.fairfield.edu Fairfield http://fordham.edu Nickname Co r1_Color2 5148 Golden Griffin Blue Gold 7730 Bluejays 5231 Titans 5061 Stags Red CT New York City NY Maroon White Fordham Georgetown htps://www.georgetown Washington D.C Gonzaga Holy Cross Loyola Chicago http://luc.edu Loyola Maryland http://imu.edu Loyola Marymount http://lmu.edu Marquette Saint Joseph's http://www.sju.edu Saint Louis Saint Peter's San Francisco https://www.usfca.edu San FranciscoCA Santa Clara Seattle Xavier 15189 Rams 17130 Hoyas http://www.gonzaga.edu Spokane http://www.holycross.ed Worcester 7874 Bulldogs/Zags Blue White 2891 Crusaders Purple White WA 1843 Chicago Baltimore Los Angeles 1870 16040 Ramblers Maroon Gold 5978 Greyhounds reen Grey 9369 Lions 1911 1881 1851 1818 1872 Crimson Blue http://marquette.edu Milwaukee 11749 Golden Eagles Blue Gold 8800 Hawks 13981 Billikens PA Philadelphia St. Louis Crimson Gray Blue White http: http://www.saintpeters.e Jersey City 15 www.slu.edu 3045 Peacocks lue White 9799 Dons 8800 Broncos 7755 Redhawks Scarlet White 6945 Musketeers Blue Gray Green Gold Santa Clara https://scu.edu https://www.seattleu.edu Seattle http://www.xavier.edu Cincinnati 1851 1891 1831 19 25 26 29 34 36 Instructions | Data Ready

Explanation / Answer

Sub UpdateRougeRanking()

'Declare variables
Dim Founded, Alphaorder, Rouge_Ranking, Enrollment As Integer
Dim temp As String
  
'Stop screen from showing code execution
Application.ScreenUpdating = False
' Set numrows = number of rows of data.

NumRows = ActiveWorkbook.Worksheets("Data").Range("A2", Range("A2").End(xlDown)).Rows.Count
  
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows
  
'Select the starting cell and keep it updated according to loop
temp = "F" & x
Range(temp).Select
  
' Selects cell down 1 row from active cell.
ActiveCell.Offset(1, 0).Select

'Collect values for Founded,Enrollment and Alphaorder

Founded = ActiveCell.Value

ActiveCell.Offset(0, 1).Select

Enrollment = ActiveCell.Value

ActiveCell.Offset(0, -6).Select

Alphaorder = ActiveCell.Value

'Based on Founded value select Rouge_Ranking and write it on excel sheet

If (Founded < 1800) Then
Rouge_Ranking = (Enrollment / Alphaorder) * 0.52
Else
If (Founded < 1900) Then
Rouge_Ranking = (Enrollment / Alphaorder) * 0.45
Else
Rouge_Ranking = (Enrollment / Alphaorder) * 0.38
End If
End If

ActiveCell.Offset(0, 10).Select

ActiveCell.Value = Rouge_Ranking

'Loop continues
Next
Application.ScreenUpdating = True
'End the module
End Sub

Related Questions

Navigate

• Browse (All)
• Browse U
• Subjects

---

---

Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.