 # Custom Function [Solved/Closed]

Posts
27
Registration date
Saturday April 18, 2009
Status
Member
Last seen
November 22, 2012
-
rizvisa1
Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
-
Hello,

wud appreciate help on me building a custom function...i've written a function which shud do the following
function in sheet A will get empid and date from sheet A, lookup the empid and date and get salary from sheet B, then based on salary amount , will lookup sheet C and get percentage, then salary / 12 * percentage is calculated and shown as value in sheet A.

m unable to select sheet B to get the salary.

----------------------------------------------------------------------------------------------------------
Public salary As Long
Function projections(emp_id As Long) As Long
Dim ThisRow As Long
Dim cutoff As Date
Application.Volatile
'Dim emp_id As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'declare sheet names
contr_indiv = "Contributions - Individual"
contr_mem = "Contributions - Member"
contr_sheet = ActiveSheet.Name

If contr_sheet = contr_indiv Then
ThisRow = Sheets("Settings").Cells(1, 3)
current_row = ThisRow + 1
myrow = ActiveCell.Row
mycol = ActiveCell.Column
With ActiveSheet
empid_col = getcol(ThisRow, "Employee ID")
emp_id = .Cells(myrow, getcol(ThisRow, "Employee ID"))
cutoff = ActiveSheet.Cells(ThisRow, mycol)
End With

Call get_salary
Call get_percent

'calculate and update values
Sheets(contr_indiv).Activate
indiv_contr = (salary / 12) * ind_percent
projections = indiv_contr

ElseIf contr_sheet = contr_mem Then
ThisRow = Sheets("Settings").Cells(2, 3)
current_row = ThisRow + 1

Else
MsgBox "Projections Functions not programmed to run on " & ActiveSheet.Name & " Sheet."
ActiveCell.Clear
End If

Application.Calculation = xlCalculationAutomatic
End Function
-----------------------------------------------------------------------------------------------------------------
Function getcol(ThisRow As Long, ColHeading As String, Optional Loc As Object) As Integer
Dim CHLen As Integer
Dim active_book_name As String
getcol = 1
If Loc Is Nothing Then Set Loc = Sheets(ActiveSheet.Name)
With Loc
Do Until LCase(Trim(.Cells(ThisRow, getcol))) = LCase(Trim(ColHeading)) Or getcol = 256
getcol = getcol + 1
Loop
End With
If getcol = 256 Then MsgBox "Can't find '" & ColHeading & "' in Row " & ThisRow: End

If getcol = 256 Then
active_book_name = ActiveWorkbook.Name

MsgBox "Please check Field Name in " & active_book_name & " and try again"
If Windows(active_book_name).Visible = True Then
Windows(active_book_name).Close (False)
Else
End If
End
Else

End If

End Function
----------------------------------------------------------------------------------------------------------
Sub get_salary()
Application.ScreenUpdating = False
Dim ThisRow As Long
'get salary data from Employee Data
Sheets("Employee Data").Select
ThisRow = Sheets("Settings").Cells(3, 3)
With Sheets("Employee Data")
empid_col = getcol(ThisRow, "Employee ID")
cutoff_col = ActiveSheet.Cells(ThisRow, cutoff)
'emp_id = ActiveSheet.Cells(myrow, getcol(ThisRow, empid_col))
End With

With Sheets("Employee Data").Columns(empid_col)
Set c = .Find(emp_id, lookat:=xlWhole)
If Not c Is Nothing Then
salary = c.Offset(0, cutoff_col)
Else
End If
End With

End Sub
----------------------------------------------------------------------------------------------------------------

Sub get_percent()
Application.ScreenUpdating = False
'get % from options sheet
Sheets("Options").Activate
col = 3
Row = 6

If activehseet.Cells(Row, col) <= salary Then
ind_percent = ActiveSheet.Cells(Row + 1, col)
Else
End If
col = col + 1

Do While ActiveSheet.Cells(Row, col) <> ""
If activehseet.Cells(Row, col - 1) > salary And ActiveSheet.Cells(Row, col) <= salary Then
ind_percent = ActiveSheet.Cells(Row + 1, col)
Else
ind_percent = ActiveSheet.Cells(Row + 1, col)
End If
col = col + 1
Loop

End Sub

## 2 replies

Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
756
Could you post a sample book to test the function
rizvisa1
Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
756
row() and column() are the two function which would send the row number and column id of the cell. So in case the formula is in E5, it will send automatically row=5, and column = 5 and when the formula is in F29, it will send row =29 and column = 6. So your activecell idea which i think was to actually your idea to get the cell address where the formula will be resolved in this way
smd_excel
Posts
27
Registration date
Saturday April 18, 2009
Status
Member
Last seen
November 22, 2012

sorry to sound naive here...how do i incorporate wat u've suggested in the formula???
rizvisa1
Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
756
Change you function definition as

Function projections(emp_id As Long, myrow as long, mycol as integer) As Long

Remove lines from function
myrow = ActiveCell.Row
mycol = ActiveCell.Column

Change the call to the function as
=projections(A5, ROW(), Column())
smd_excel
Posts
27
Registration date
Saturday April 18, 2009
Status
Member
Last seen
November 22, 2012

thanks a ton dude...tht was perfect...
rizvisa1
Posts
4475
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
756
Glad it worked out for you. Good luck
Posts
27
Registration date
Saturday April 18, 2009
Status
Member
Last seen
November 22, 2012

the File is uploaded - https://authentification.site/files/23359445/EBT_-_Projections.xlsm
i have written the function to correct the problem i earlier requested. theres another problem now.....if i drag the formula across the column the values are not getting updated. i need press F2 in every cell of the formula to get the new values. and when i save the workbook all the formulas get recalculated with the same value which equals to the value in the last cell.
Recommended

DON'T MISS

TRENDING GAMES & APPS