Solved: Find and Copy minimum values to other sheet

[ertan]

Need help for finding minumum value, in each section and copy to Sheet2

In each Product title I would like to find the minumum value if possible mark with red font and copy entire row with the product title to next sheet.

And do this next Product..

Finally Sheet2 would be summary of all products with minumum values .

Thank you for your help

PS Attached sample sheet. (Sheet1 _ List , Sheet2_ desired result)

[jindon]

Hi
try

Sub test()
Dim r As Range, ff As String
With Sheets("sheet1")
Set r = .Columns("a").Find("Product", .Cells(1, 1), , xlPart)
If Not r Is Nothing Then
ff = r.Address
i = 1
Sheets("sheet2").Range("b2").CurrentRegion.Clear
Do
Set rng = .Range(r, r.End(xlDown)).Resize(, 3)
mymin = Application.Min(rng.Columns("c"))
i = i + 1
With Sheets("sheet2").Cells(i, "b")
.Value = r.Value
.Offset(, 1) = _
Application.Index(rng, Application.Match(mymin, rng.Columns("c"), 0), 1)
.Offset(, 2) = _
Application.Index(rng, Application.Match(mymin, rng.Columns("c"), 0), 2)
.Offset(, 3) = mymin
End With
Set r = .Columns("a").FindNext(r)
Loop Until r.Address = ff
End If
End With
If i > 1 Then
With Sheets("sheet2").Range("b2").CurrentRegion
With .Columns("a").Font
.Bold = True
.Color = vbRed
End With
With .Offset(, 1).Resize(, .Columns.Count - 1)
.Borders.Weight = xlThin
End With
.Columns("c").Font.Bold = True
End With
End If
End Sub

[ertan]

Hi Jindon,

Works like clock.. excellent..

But only problem those Product1 , Product2 etc.. Actually given by example.
In real life these are in- consistent names of the products..
(I mean they don?t have similarities)

if one name is Book
Other could be Pen
Other Calendar

Etc..

Only " PRC" part is consistent , in column C .

Is it possible change the code that will find "PRC" in column C and
copy " 1 row up 2 column left " (that will be the product name..)

Really appreciated your effort to help me..

[jindon]

Hi
Can you change 2 lines?
1)


Set r = .Columns("a").Find("Product", .Cells(1, 1), , xlPart)
To;


Set r = .Columns("a").Find("*", .Cells(1, 1), , xlPart)
2)

Set r = .Columns("a").FindNext(r)
To;

Set r = .Columns("a").Find("*", r.Offset(rng.Rows.Count))

[ertan]

Hi Jindon,

Thank you for your support.
Yes with the changes you provide everything works perfect..
Saved me a lot of time...

All the best for you ..

Thank you again

Ertan

[ertan]

I am sorry I couldnt remember how to mark this thread as Solved...

Ertan

[geekgirlau]

It's behaving a bit erratically at the moment due to the board upgrade, but normally you use "Thread Tools" at the top of the page.