Custom Function - Calculate Profit
Custom Function - Instr function
Custom Function - calculation Income
Function income(age, salary)
If age > 0 And age <= 18 Then
pension = 1500
ElseIf age > 18 And age <= 60 Then
pension = 1000
Else: pension = 1500
End If
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
income = pension + Bonus
End Function
Custom Function - Lastrow
Function Lastrow()
Lastrow = Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row
End Function
Custom Function - Countspaces in cell
Function countspaces(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
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()
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
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
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