Excel VBA help please-CodePudding

I'm wanting to automate a few things in Excel, problem is I am definitely not a programmer / scripter so this is all foreign to me.

So I have a list that changes in length every time I import a new set of values, what I want is for the program to check column a (with a header) for certain values IE:

Sub Grade()
    If Range("A2").Value = 2031 Then
        Range("H2").Value = "Grade 4"
        ElseIf Range("A2").Value = 2030 Then
        Range("H2").Value = "Grade 5"
        ElseIf Range("A2").Value = 2029 Then
        Range("H2").Value = "Grade 6"
        ElseIf Range("A2").Value = 2028 Then
        Range("H2").Value = "Grade 7"
        ElseIf Range("A2").Value = 2027 Then
        Range("H2").Value = "Grade 8"
        ElseIf Range("A2").Value = 2026 Then
        Range("H2").Value = "Grade 9"
        ElseIf Range("A2").Value = 2025 Then
        Range("H2").Value = "Grade 10"
        ElseIf Range("A2").Value = 2024 Then
        Range("H2").Value = "Grade 11"
        ElseIf Range("A2").Value = 2023 Then
        Range("H2").Value = "Grade 12"
              
    End If
End Sub

That works fine to input the value in cell H2, but I want it now to go down the column and check the rest, which is where I'm having difficulties. Problem is this time there are 15 entries but when I do this again there could only be 3. So I'm looking to have it check the column and run that script as long as the cell isn't blank.

Any assistance is appreciated.

CodePudding user response：

I have simply put the following formula in H2:

="Grade " & (2035-B2)

You can easily drag and drop to other cells and do minor changes, without even needing VBA.

CodePudding user response：

Something like below could work:

Option Explicit

Public Sub GenerateGrade()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")  'ThisWorkbook.ActiveSheet
    
    Dim LastRow As Long  ' find last used row
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    Dim iRow As Long
    For iRow = 2 To LastRow  ' loop through all rows
        ' if between 2023 and 2031 calculate grade
        If ws.Cells(iRow, "A") >= 2023 And ws.Cells(iRow, "A") <= 2031 Then
            ws.Cells(iRow, "H") = "Grade " & (2031 - ws.Cells(iRow, "A"))   4
        End If
    Next iRow
End Sub

You can actually just calculate the grade out of the values in column A:

Grade = 2031 - ValueA   4

CodePudding user response：

Loop Through the Rows of a Column

If the numbers are not so 'convenient' you could use something like the following.

Option Explicit

Sub Grade()
    
    Dim Grades As Variant
    Grades = VBA.Array(2031, 2030, 2029, 2028, 2027, 2026, 2025, 2024, 2023)
    Dim GradeTitles As Variant
    GradeTitles = VBA.Array("Grade 4", "Grade 5", "Grade 6", "Grade 7", _
        "Grade 8", "Grade 9", "Grade 10", "Grade 11", "Grade 12")
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    Dim rIndex As Variant
    Dim r As Long
    
    For r = 2 To lRow
        rIndex = Application.Match(ws.Cells(r, "A").Value, Grades, 0)
        If IsNumeric(rIndex) Then
            ws.Cells(r, "H").Value = GradeTitles(rIndex - 1)
        Else
            ws.Cells(r, "H").Value = Empty
        End If
    Next r

End Sub

CodePudding user response：

You can choose a range sufficiently wide and add a formula that only show values when you have grades.

I have chosen A2:A200 as an example. Then the formula should be:

=IF(ISNUMBER(A2:A200),"Grade " & (2035-A2:A200), "")

If it finds a number in column A, it calculates the grade. If not, it keeps the cell empty (""). This way, you don't need to go down the column.

The final result is the following.