Printable View
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
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
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
Code: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
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
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
Hi mtsf26,
Please don't quote entire the post until and unless it's unavoidable. :)
Hello mtsf26,
Try the attached with your original data structure.
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/...sf26/error.jpg and i also attached the file.so i add module in xxx sheet
Hi,
There is no Code in it. Please Paste code and save it as .xlsm file and then attach the file.
i dont knw this is what u mean or not.hehehe
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
Code:
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
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.
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
------------------
it work.thanks for helping me and solving this problem.