obtain data from 3 input with conditions

[mtsf26]

i make this table and is it possible to obtain the data from other sheet with 3 input based on length, diameter and quality.please kindly help me to solve it to get the exact data.
how to get the price from HJD-sono tab? If :
1. class = a, price + 10% of price
2. class = b, price + 7.5% of price
3. class = c, price + 5 % of price
4. class = d, price + 2.5% of price
5. class = e, price
i have attached the file too.hope you guys able to help me

[Admin]

Hi mtsf26,

Welcome to ExcelFox !!!

It can be done with formulas, though you need to make some adjustments in the layout.

Replace diameter

0-19 20-29 30-39 40-49 50-59 60 up

with

0 20 30 40 50 60

also replace length

50 - 90
100 - 190
200 - 290
300 - 390
400 UP
50 - 90
100 - 190
200 - 290
300 - 390
400 UP
50 - 90
100 - 190
200 - 290
300 - 390
400 UP
50 - 90
100 - 190
200 - 290
300 - 390
400 UP

with

50
100
200
300
400
50
100
200
300
400
50
100
200
300
400
50
100
200
300
400

In E2 and copied down

=INDEX(Price,MATCH(C2,Quality,0)+MATCH(B2,{50,100, 200,300,400})-1,MATCH(A2,Dia))*LOOKUP(D2,{"a",1.1;"b",1.075;"c",1.05;"d",1.025;"e",1})

where Price,Quality,Dia are named ranges.

HTH

[littleiitin]

or you can use Below VBA Code:

Follow Below Steps:
1: Activate your file
2: Press Alt+F11
3: In Exteam Left side You can see list of your sheets. Just Right Click any of the sheet
4: Click Insert--->Module
5: Paste Below code in Blank Area
6: Press F5




Sub CalculatePrice()

Dim rngCell As Range
Dim rngCellC As Range
Dim rngCellR As Range
Dim rngWholeC As Range
Dim rngWholeR As Range
Dim rngWholeRow As Range
Dim rngWhole As Range
Dim rngQuality As Range
Dim lngCol As Long
Dim lngRow As Long
Dim sngPrice As Single

With ThisWorkbook.Worksheets("HJD-sono")
Set rngWholeC = .Range(.Range("C3"), .Cells(3, .Columns.Count).End(xlToLeft))
Set rngWholeR = .Range("A4:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
With ThisWorkbook.Worksheets("XXX")
Set rngWhole = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
For Each rngCell In rngWhole
'Finding Column
For Each rngCellC In rngWholeC
On Error GoTo X1:
If rngCell.Value >= CLng(Mid(rngCellC.Value, 1, InStr(1, rngCellC.Value, "-"))) And rngCell.Value <= CLng(Mid(rngCellC.Value, InStr(1, rngCellC.Value, "-") + 1, Len(rngCellC.Value) - InStr(1, rngCellC.Value, "-"))) Then
X1:
lngCol = rngCellC.Column
Exit For
End If
Next rngCellC

'Finding Quality
Set rngWholeRow = Nothing
For Each rngQuality In rngWholeR
If rngQuality.Value = rngCell.Offset(, 2).Value Then
If rngWholeRow Is Nothing Then
Set rngWholeRow = rngQuality
Else
Set rngWholeRow = Union(rngWholeRow, rngQuality)
End If
End If
Next

'Finding Row
Set rngWholeRow = rngWholeRow.Offset(, 1)
For Each rngCellR In rngWholeRow
On Error GoTo X2:
If rngCell.Offset(, 1).Value >= CLng(Mid(rngCellR.Value, 1, InStr(1, rngCellR.Value, "-") - 2)) And rngCell.Offset(, 1).Value <= CLng(Trim(Mid(rngCellR.Value, InStr(1, rngCellR.Value, "-") + 1, Len(rngCellR.Value)))) Then
X2:
lngRow = rngCellR.Row
Exit For
End If
Next rngCellR

'Finding Price
With ThisWorkbook.Worksheets("HJD-sono")
sngPrice = .Cells(lngRow, lngCol).Value
End With
'Calculating Exact Price
If rngCell.Offset(, 3).Value = "a" Then
rngCell.Offset(, 4) = sngPrice + (sngPrice * 0.1)
ElseIf rngCell.Offset(, 3).Value = "b" Then
rngCell.Offset(, 4) = sngPrice + (sngPrice * 0.075)
ElseIf rngCell.Offset(, 3).Value = "c" Then
rngCell.Offset(, 4) = sngPrice + (sngPrice * 0.05)
ElseIf rngCell.Offset(, 3).Value = "d" Then
rngCell.Offset(, 4) = sngPrice + (sngPrice * 0.025)
ElseIf rngCell.Offset(, 3).Value = "e" Then
rngCell.Offset(, 4) = sngPrice
End If
Next rngCell
End With
End Sub

[mtsf26]

hi admin.thanks it work..

@ littleiitin

hey thanks for the code.but i just confused i cant debug it,and seems something wrong with this line:
If rngCell.Offset(, 1).Value >= CLng(Mid(rngCellR.Value, 1, InStr(1, rngCellR.Value, "-") - 2)) And rngCell.Offset(, 1).Value <= CLng(Trim(Mid(rngCellR.Value, InStr(1, rngCellR.Value, "-") + 1, Len(rngCellR.Value)))) Then
X2:

i still curious with you code.hoep you can help to fix it too.thanks

[littleiitin]

Hi mtsf26,

Its working fine at my end. Please Re paste the code and Run it.

If still facing issue please attach your file with code.

I will fix it.

Thanks
Rahul Kumar Singh

[Admin]

Hi mtsf26,

Please don't quote entire the post until and unless it's unavoidable. :)

[Haseeb A]

Hello mtsf26,

Try the attached with your original data structure.

[mtsf26]

hi admin thanks to edit my post. :) sorry for quoting it.
@haseeb what CurrRange function is?and when im copy it into other workbook its not wrking
@littleiitin here the screenshoot of error http://i1106.photobucket.com/albums/h367/mtsf26/error.jpg and i also attached the file.so i add module in xxx sheet

[littleiitin]

Hi,

There is no Code in it. Please Paste code and save it as .xlsm file and then attach the file.

[mtsf26]

i dont knw this is what u mean or not.hehehe

[littleiitin]

Yes I meant the same. If there is code in your file then it will work like that.

The error occoured because in place of (0-19 | 20-29 ....and so on) in diameter you change the criteria to Min and Max

Please paste below code and press F5: and Save File as Xlsm File only





Sub CalculatePrice()

Dim rngCell As Range
Dim rngCellC As Range
Dim rngCellR As Range
Dim rngWholeC As Range
Dim rngWholeR As Range
Dim rngWholeRow As Range
Dim rngWhole As Range
Dim rngQuality As Range
Dim lngCol As Long
Dim lngRow As Long
Dim sngPrice As Single

With ThisWorkbook.Worksheets("HJD-sono")
Set rngWholeC = .Range(.Range("C3"), .Cells(3, .Columns.Count).End(xlToLeft))
Set rngWholeR = .Range("A4:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
With ThisWorkbook.Worksheets("XXX")
Set rngWhole = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
For Each rngCell In rngWhole
'Finding Column
For Each rngCellC In rngWholeC
On Error GoTo X1:
If rngCell.Value >= rngCellC.Value And rngCell.Value <= rngCellC.Offset(1).Value Then
X1:
lngCol = rngCellC.Column
Exit For
End If
Next rngCellC

'Finding Quality
Set rngWholeRow = Nothing
For Each rngQuality In rngWholeR
If rngQuality.Value = rngCell.Offset(, 2).Value Then
If rngWholeRow Is Nothing Then
Set rngWholeRow = rngQuality
Else
Set rngWholeRow = Union(rngWholeRow, rngQuality)
End If
End If
Next

'Finding Row
Set rngWholeRow = rngWholeRow.Offset(, 1)
For Each rngCellR In rngWholeRow
On Error GoTo X2:
If rngCell.Offset(, 1).Value >= rngCellR.Value And rngCell.Offset(, 1).Value <= rngCellR.Offset(, 1).Value Then
X2:
lngRow = rngCellR.Row
Exit For
End If
Next rngCellR

'Finding Price
With ThisWorkbook.Worksheets("HJD-sono")
sngPrice = .Cells(lngRow, lngCol).Value
End With
'Calculating Exact Price
If rngCell.Offset(, 3).Value = "a" Then
rngCell.Offset(, 4) = sngPrice + (sngPrice * 0.1)
ElseIf rngCell.Offset(, 3).Value = "b" Then
rngCell.Offset(, 4) = sngPrice + (sngPrice * 0.075)
ElseIf rngCell.Offset(, 3).Value = "c" Then
rngCell.Offset(, 4) = sngPrice + (sngPrice * 0.05)
ElseIf rngCell.Offset(, 3).Value = "d" Then
rngCell.Offset(, 4) = sngPrice + (sngPrice * 0.025)
ElseIf rngCell.Offset(, 3).Value = "e" Then
rngCell.Offset(, 4) = sngPrice
End If
Next rngCell
End With
End Sub

[mtsf26]

like this one??i have attached the file again with min and max.and when i run it there is no problem.now my problem is how to show me the result.heheh.i know nothing about macro actually.

[littleiitin]

Hi,

Actually it is showing in E column of sheet "xxx" when you are pressing F5.

For Easy interfacing: You can insert any shape in sheet "XXX" from Insert -> Shapes-> Select any shape

Now right Click this shape -> assign Macro

You will see a Dialog box: Select "CalculatePrice" from List Press Ok . Save your workbook

Now Clear your Column E Values and Press The Shape. You can see the result in E Column

Thanks
Rahul Kumar Singh

HTH
------------------

[mtsf26]

it work.thanks for helping me and solving this problem.