Custom Function - Calculate Profit

     


     

    Custom Function - Instr function

     

     

     

    Custom Function - calculation Income

     

  • Used two Functional Arguments
  •  

    Code

    Function income(age, salary)
    'First Functional Argument AGE
    If age > 0 And age <= 18 Then
    pension = 1500
    ElseIf age > 18 And age <= 60 Then
    pension = 1000
    Else: pension = 1500
    End If
    'second Functional Argument SALARY
    If salary > 0 And salary < 10000 Then
    Bonus = salary * 0.1
    ElseIf salary >= 10000 And salary < 20000 Then
    Bonus = salary * 0.2
    Else: Bonus = salary * 0.3
    End If
    'Formula is sum of two arguments
    income = pension + Bonus
    End Function

     

     

    Custom Function - Lastrow

     

  • Function defined with No Functional arguments
  •  

    Function Lastrow()
    Lastrow = Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row
    End Function

     

    Custom Function - Countspaces in cell

     

  • Single functional argument has been used
  • Function countspaces(cellvalue)
    'Defining functional argument as cellvalue
    countspaces = UBound(Split(cellvalue, " "))
    End Function

     

     

    Private Sub CommandButton1_Click()
    lastrow = Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To lastrow
    Cells(i, 2).Value = countspaces(Range("A" & i))
    Next
    End Sub

     

    Custom Function - Grading

     

  • Using Single functional argument
  •  

    Function mksgrading(marks)
    If marks <= 90 And marks > 70 Then
    mksgrading = "Grade A"
    ElseIf marks <= 70 And marks > 50 Then
    mksgrading = "Grade B"
    ElseIf marks <= 50 And marks > 35 Then
    mksgrading = "Grade C"
    ElseIf marks <= 35 And marks > 0 Then
    mksgrading = "Fail"
    Else: mksgrading = "Exceptional"
    End If
    End Function

     

     

    Private Sub CommandButton1_Click()
    Dim lastrow, i
    lastrow = Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To lastrow
    Cells(i, 2).Value = mksgrading(Range("A" & i))
    Next
    End Sub

     

     

     

    Custom Function - Sum Top 5 through Large function

     

    Function sumtop()
    'sum large 5 values
    Range(Range("B2"), Range("B2").End(xlDown)).Rows.Select
    For i = 1 To 5
    sumtop = sumtop + WorksheetFunction.Large(Selection, i)
    Next
    End Function

     

     

    Private Sub CommandButton1_Click()
    MsgBox sumtop
    Range("D5").Value = sumtop
    End Sub

     

     

     

    Custom Function - Age Status

     

    Function status(age)
    If age > 0 And age <= 18 Then
    status = "Minor"
    ElseIf age <= 60 And age > 18 Then
    status = "Major"
    Else: status = "senior Citizen"
    End If
    End Function
    'To execute query
    Private Sub CommandButton1_Click()
    Dim i As Integer
    For i = 2 To 9
    Range("B" & i).Value = status(Range("A" & i).Value)
    Next
    End Sub

     

     

    Custom Function - Fare calculation

     

    Private Sub CommandButton1_Click()
    Dim i As Integer
    For i = 2 To 11
    Cells(i, 3) = farecalc(Range("A" & i))
    Next
    End Sub
    Defining Function Function farecalc(distance)
    If distance <= 90 And distance > 70 Then
    farecalc = distance * 5
    ElseIf distance <= 70 And distance > 50 Then
    farecalc = distance * 4
    ElseIf distance <= 50 And distance > 35 Then
    farecalc = distance * 3
    ElseIf distance <= 35 And distance > 25 Then
    farecalc = distance * 2
    Else: farecalc = "Free"
    End If
    End Function

     

    Custom Function - Marks Grading

     

    Function mksgrade(marks As Single) As String
    Select Case marks
    Case 90 To 100
    mksgrade = "Topper"
    Case 76 To 90
    mksgrade = "Distinction"
    Case 61 To 75
    mksgrade = "First"
    Case 51 To 60
    mksgrade = "Second"
    Case 36 To 50
    mksgrade = "Third"
    Case 0 To 35
    mksgrade = "Fail"
    End Select
    End Function
    Private Sub CommandButton1_Click()
    Dim i As Integer
    For i = 1 To 10
    Cells(i, 2).Value = mksgrade(Cells(i, 1).Value)
    Next
    End Sub

     

     

     

     

    Custom Function - Excel Path

     

    Function wkbPath() As String
    wkbPath = ThisWorkbook.Path
    End Function

     

    Function Apppath()
    Apppath = Application.Path
    End Function

     

     

     

    Custom Function - SUM Top 3

     

    Function SumTop(Data, Numbers)
    Dim i As Integer
    For i = 1 To Numbers
    SumTop = SumTop + Application.WorksheetFunction.Large(Data, i)
    Next
    End Function