Hello,
My level of English is very low and I hope you understand me.
I do not quite understand your problem, but perhaps a solution with a custom function.
Copy the code below into a standard module.
'### Adapt this constants ###
Const MALE As String = "M"
Const FEMALE As String = "F"
'### Adapt this constants ###
Function PROPERWEIGHT(Age As Variant, Height As Variant, Optional Genre As Variant = MALE) As Variant
Dim R As Range
Dim var As Variant
Dim i&
Dim Lig&
Dim Col&
Dim AddPounds&
Dim Pounds As Variant
Dim TopAgeBracket As Variant
Application.Volatile True
TopAgeBracket = Array(21, 28, 40)
Age = CInt(Age)
If Age >= 17 Then
Set R = Worksheets("Sheet4").Range("a5:i27")
var = R
'--- Row ---
If Height <= 80 Then
For i& = 1 To UBound(var, 1)
If Height = var(i&, 1) Then
Lig& = i&
Exit For
End If
Next i&
Else
Lig& = UBound(var, 1)
AddPounds& = Height - 80
End If
'--- Column ---
Col& = 5
For i& = UBound(TopAgeBracket) To LBound(TopAgeBracket) Step -1
If Age < TopAgeBracket(i&) Then Col& = i& + 2
Next i&
If UCase(Genre) = UCase(FEMALE) Then Col& = Col& + 4
'--- Pounds ---
Pounds = var(Lig&, Col&)
'--- Add 6 pounds per inch for males over 80 inches and ---
'--- 5 pounds for females for each inch over 80 inches ---
If Height > 80 Then
If UCase(Genre) = UCase(MALE) Then
Pounds = Pounds + (AddPounds& * 6)
ElseIf UCase(Genre) = UCase(FEMALE) Then
Pounds = Pounds + (AddPounds& * 5)
End If
End If
PROPERWEIGHT = Pounds
ElseIf Age = 0 Or Age < 17 Then
PROPERWEIGHT = vbNullString
End If
End Function
PROCEDURE
The function has 3 arguments
Function PROPERWEIGHT (Age As Variant, Height As Variant, Optional Gender = MALE As Variant) As Variant
Age: enter a number OR a cell address
Height: enter a number OR a cell address
Gender: enter M or F (you can change the constants Const MALE As String = "xxx" Const FEMALE As String = "yyy") OR a cell address
EXAMPLE
PROPERWEIGHT = (AA2, AB2, "M") or PROPERWEIGHT = (28, 65, "m") or PROPERWEIGHT = (AA2, AB2, C2) where C2 contains either F or H.
I hope I was clear.
I put your workbook as an attachment in which I have removed the worksheets that were not needed.
Best regards.
PMO
Patrick Morange
Bookmarks