-
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
-
1 Attachment(s)
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.