View Full Version : Grade calculator this should be easy fix
crender
08-23-2018, 06:50 AM
This code works fine for cell a1 and b1. Let say I have 500 scores in Column a and I want the program to go down column A and tell me who all passed. I am thinking I will need to use a vlookup but is there a way to do it with this code?
Sub grades()
Dim scores As Integer, result As String
score = Range("A1").Value
If score >= 60 Then result = "pass"
Range("b1").Value = result
Paul_Hossler
08-23-2018, 07:46 AM
Something like this maybe?
If the grades are ALWAYS non-formulas, you don't need the second part, but it doesn't hurt
Option Explicit
Sub PassFail()
Dim r As Range
With ActiveSheet
On Error Resume Next
For Each r In .Columns(1).SpecialCells(xlCellTypeConstants, xlNumbers).Cells
If r.Value >= 60 Then
r.Offset(0, 1).Value = "Pass"
Else
r.Offset(0, 1).ClearContents
End If
Next
On Error Resume Next
For Each r In .Columns(1).SpecialCells(xlCellTypeFormulas, xlNumbers).Cells
If r.Value >= 60 Then
r.Offset(0, 1).Value = "Pass"
Else
r.Offset(0, 1).ClearContents
End If
Next
On Error GoTo 0
End With
End Sub
Kenneth Hobs
08-23-2018, 07:46 AM
Welcome to the forum!
Sub Main()
[B1].Formula = "=If(A1>=60,""Pass"",""Fail"")"
[B1].Copy Range("B2", Cells(Cells(Rows.Count, "A").End(xlUp).Row, "B"))
End Sub
crender
08-23-2018, 07:59 AM
Welcome to the forum!
Sub Main()
[B1].Formula = "=If(A1>=60,""Pass"",""Fail"")"
[B1].Copy Range("B2", Cells(Cells(Rows.Count, "A").End(xlUp).Row, "B"))
End Sub
That is really clean and short. I like that.
I really don't understand how to read the second line. The first line I get that is just your formula for b1.
Kenneth Hobs
08-23-2018, 08:25 AM
It simply copies B1 from B2 to B's row that is the last row number from the bottom up for column A.
Cell()'s 2nd input can be the column number or column letter which can be handy. In VBE's Immediate Window, you can paste this and press Enter Key to see how that part works.
Cells(Rows.Count, "A").End(xlUp).Row
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.