vba lingo

Option Explicit
Sub Question_A()
    Selection.End(xlDown).Select
    Range("A48").Select
End Sub

Sub Question_B()
    Dim newcode As String

    newcode = InputBox("Please Enter a New Code")

    Range("a1").End(xlDown).Select
    ActiveCell.Offset(1, 0).Value = newcode
End Sub

Sub Question_C()
    Dim newcode As String
    Dim expense As Currency

    newcode = InputBox("Please Enter a New Code")
    expense = InputBox("Please Enter the Expected Expense for the new item")

    Range("a1").End(xlDown).Select
    ActiveCell.Offset(1, 0).Value = newcode
    ActiveCell.Offset(1, 1).Value = expense
End Sub

Sub Question_D()
    Dim newcode As String
    Dim predexpense As Currency
    Dim actexpense As Currency

    newcode = InputBox("Please Enter a New Code")
    predexpense = InputBox("Plscsease Enter the Expected Expense for the new item")
    actexpense = InputBox("Please Enter the Actual Expense for the new item")

    Range("a1").End(xlDown).Select
    ActiveCell.Offset(1, 0).Value = newcode
    ActiveCell.Offset(1, 1).Value = predexpense
    ActiveCell.Offset(1, 2).Value = actexpense
End Sub

Sub Question_E()
    With Range("a1")
        Range(.Offset(1, 0), .End(xlDown)).Name = "ItemCodes"
    End With
    With Range("b1")
        Range(.Offset(1, 0), .End(xlDown)).Name = "PredictedExpense"
    End With
    With Range("c1")
        Range(.Offset(1, 0), .End(xlDown)).Name = "ActualExpense"
    End With
End Sub

Sub Question_F()
    Dim item As Range
    Dim predict As Currency
    Dim actual As Currency

    With Range("a1")
        Range(.Offset(1, 0), .End(xlDown)).Name = "ItemCodes"
    End With

    For Each item In Range("Itemcodes")
        predict = item.Offset(0, 1).Value
        actual = item.Offset(0, 2).Value

        With item
            If actual > predict - 100 Then
                Range(.Offset(0, 0), .End(xlToRight)).Interior.Color = vbYellow
            End If

            If actual > predict + 100 Then
                Range(.Offset(0, 0), .End(xlToRight)).Interior.Color = vbRed
            End If

            If actual < predict Then
                Range(.Offset(0, 0), .End(xlToRight)).Interior.Color = vbGreen
            End If
        End With
    Next
End Sub

Sub Question_G()
    Dim counter As Integer
    Dim totalrows As Integer
    Dim totalpred As Currency
    Dim totalactual As Currency

    With Range("a1")
        totalrows = Range(.Offset(1, 0), .End(xlDown)).Rows.count
    End With

    For counter = 1 To totalrows Step 1
        totalpred = totalpred + Range("a1").Offset(counter, 1).Value
        totalactual = totalactual + Range("a1").Offset(counter, 2).Value
    Next
     MsgBox "The total predicted expenses are: £" & totalpred
     MsgBox "The total actual expenses are: £" & totalactual
End Sub

Sub Question_H()
    Dim predict As Currency
    Dim actual As Currency
    Dim difference As Currency
    Dim item As Range
    Dim code As String

    With Range("E3")
        Range(.Offset(0, 0), .End(xlDown)).ClearContents
    End With

    With Range("a1")
        Range(.Offset(1, 0), .End(xlDown)).Name = "ItemCodes"
    End With

    For Each item In Range("ItemCodes")
        predict = item.Offset(0, 1).Value
        actual = item.Offset(0, 2).Value
        difference = actual - predict
        code = item.Value

        If difference > 500 Then
            Range("E1").End(xlDown).Select
            ActiveCell.Offset(1, 0).Value = item.Value
            ActiveCell.Offset(1, 1).Value = difference
        End If
    Next
End Sub

Sub Question_I()

    Dim max As Long
    Dim item As Range
    Dim predict As Currency
    Dim actual As Currency
    Dim code As String

    With Range("E1")
        Range(.Offset(2, 0), .End(xlDown)).Name = "ItemCodes"
    End With


    For Each item In Range("Itemcodes")
        If item.Offset(0, 1).Value > max Then
        max = item.Offset(0, 1).Value
        End If
    Next

    For Each item In Range("Itemcodes")
        If item.Offset(0, 1) = max Then
           item.Font.Bold = True
           item.Offset(0, 1).Font.Bold = True
        End If
    Next

    With Range("a1")
        Range(.Offset(1, 0), .End(xlDown)).Name = "ItemCodes"
    End With

    For Each item In Range("Itemcodes")
        If item.Offset(0, 2) - item.Offset(0, 1) = max Then
            actual = item.Offset(0, 2).Value
            predict = item.Offset(0, 1).Value
            code = item.Value
        End If
    Next
    MsgBox "the maximum difference is: " & max & "This is Item: " & code & "it has a actual of: " & actual & " and a predicted of: " & predict
End Sub