Find min value in a range

[Apple Ang]

Hi All,
Good day!

I would like to have a macr which can help me to find the lowest price in a range then copy the value & vendor to column next to price. I can do it if the range is in column but not as below.

My data as below:

Book1
	A	B	C	D
1	Part	Vendor	Price
2	P1	V1	0.01
3	P1	V2	0.01
4	P1	V3	0.015
5	P1	V4	0.02
6	P2	V1	0.35
7	P2	V5	0.37
8	P2	V6	0.355
9	P2	V3	0.36
10	P3	V7	1.3
11	P3	V5	1.2
12	P3	V4	1.15
Sheet1

As example, there are 4 vendor can supply part P1 with different price. V1 & V2 are the vendor with lowest prices. This macro will help me to copy the vendor & price to first row of P1.
The result should as below:

Book1
	A	B	C	D	E
1	Part	Vendor	Price	SelectedVendor	Lowerprice
2	P1	V1	0.01	V1	0.01
3	P1	V2	0.01	V2	0.01
4	P1	V3	0.015
5	P1	V4	0.02
6	P2	V1	0.355	V6	0.35
7	P2	V5	0.37
8	P2	V6	0.35
9	P2	V3	0.36
10	P3	V7	1.3	V5	1.2
11	P3	V5	1.2
12	P3	V4	1.15
Sheet1

Can somebody help me on this?

 

[GlennUK]

What if more than one item has the lowest value?

 

[agihcam]

try;

Sub sample()
Dim mrange As Range
Range("A2").Activate
Application.ScreenUpdating = False
Range("d1").Resize(, 2) = Array("Selected Vendor", "Lower Price")
Range("d2:e" & Range("a" & Rows.Count).End(xlUp).Row).ClearContents
start:
s = ActiveCell.Row
Do While ActiveCell.Value = ActiveCell.Offset(1).Value And ActiveCell.Offset(1) <> ""
ActiveCell.Offset(1).Activate
Loop
l = ActiveCell.Row
Set mrange = Range("c" & s & ":" & "c" & l)
For Each c In mrange
If c.Value = WorksheetFunction.Min(mrange) And c.Offset(1).Value = c.Value Then
Range("d" & s).Resize(, 2) = Array(c.Offset(, -1), WorksheetFunction.Min(mrange))
Range("d" & s + 1).Resize(, 2) = Array(c.Offset(1, -1), WorksheetFunction.Min(mrange))
ElseIf c.Value = WorksheetFunction.Min(mrange) And Range("d" & s) = "" Then
Range("d" & s).Resize(, 2) = Array(c.Offset(, -1), WorksheetFunction.Min(mrange))
End If
Next
ActiveCell.Offset(1).Activate
If ActiveCell.Offset(1) = "" Then Exit Sub
GoTo start:
Application.ScreenUpdating = True
End Sub

 

[Apple Ang]

Hi Agihcam & Glenn,

Thanks to both of you. It really help me a lot.

If there are more then 2 parts with lowest prices, I hope that parts can be highlighted.

Again, thanks.

 

[venkat1926]

if you want a spradsheet solution:

the unique values are in column D (by using advance filter) and see the formulas in E2. copy E2 formula down .
spreadsheet is given below.

Book3
	A	B	C	D	E
1	Part	Vendor	Price
2	P1	V1	0.01	V1	0.01
3	P1	V2	0.01	V2	0.01
4	P1	V3	0.015	V3	0.015
5	P1	V4	0.02	V4	0.02
6	P2	V1	0.35	V5	0.37
7	P2	V5	0.37	V6	0.355
8	P2	V6	0.355	V7	1.3
9	P2	V3	0.36
10	P3	V7	1.3
11	P3	V5	1.2
12	P3	V4	1.15
Sheet1

 

[venkat1926]

if you want a spradsheet solution:

the unique values are in column D (by using advance filter) and see the formulas in E2. copy E2 formula down .
spreadsheet is given below.
you have to invoke formula by control shift enter.

Book3
	A	B	C	D	E
1	Part	Vendor	Price
2	P1	V1	0.01	V1	0.01
3	P1	V2	0.01	V2	0.01
4	P1	V3	0.015	V3	0.015
5	P1	V4	0.02	V4	0.02
6	P2	V1	0.35	V5	0.37
7	P2	V5	0.37	V6	0.355
8	P2	V6	0.355	V7	1.3
9	P2	V3	0.36
10	P3	V7	1.3
11	P3	V5	1.2
12	P3	V4	1.15
Sheet1