obtain data from 3 input with conditions

[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.