PDA

View Full Version : Solved: Mark minumums by columns in each segment

ertan
03-04-2007, 12:21 PM
Hello all,

In fixed 8 column data (unlimited rows) need to fınd minimum value and mark with color.
And need to do this for each segment.(segments marked as borderlined
numbers ie.7 8 9 10 11 12 13 and 14)
Example worksheet attached.

Current macro does what is supposed to do but takes nul values
into consideration.
Which not desired. Need only marked minumum values and avoid zero or nul values.

Any help wellcome.
Thank you

Simon Lloyd
03-04-2007, 02:32 PM
Why not use conditional formatting on your worksheet you can use this formula

=IF(B4=MIN(\$B\$4:\$I\$6),TRUE,FALSE)
then choose a colour!

Regards,
SImon

P.S see attached!

mdmackillop
03-04-2007, 05:42 PM
To avoid 0, needs a little more (courtesy of Shazam (http://www.vbaexpress.com/forum/showpost.php?p=91247&postcount=9)). You might want to make up some code to write these formulae into each segment.
For the first block.
=IF(C4=LARGE(\$B\$4:\$I\$6,COUNTIF(\$B\$4:\$I\$6,">0")),TRUE,FALSE)

ertan
03-05-2007, 12:13 AM

But I am afraid I wasnt very clear on my question.
Need mark min values column vise ..

For the first segment :

Column B B4:B6, Column C C4:C6, etc..till Column I
and need to do this for each segment..

Next segment would be:

Column B B8:B10, Column C C8:C10 etc..

Conditional formula not preferred , since I wouldnt know how many rows will be and dont know know how to conditionaly format for the given conditions above.

And I think "mdmackillop" solution also address the finding minimum (avoiding nul values) on each segment but row vise.

If you would run the macro on my original example you will see what I mean.
Only problem there is marking nul values (blanks ) as minimum . Need correction there if possible.

Thank you very much for your support

xld
03-05-2007, 03:13 AM
Whilst I agree that Malcolm's idea ius the preferred approach, as the data blocks are not uniform in size, I think that the formula would get enormous, so I offer more VBA.

Sub minp()
Dim iLastRow As Long
Dim i As Long, j As Long
Dim aryMin(1 To 10, 1 To 2)

With ActiveSheet

iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

'move down to first data row
i = 1
Do While .Cells(i, "A").Value = ""
i = i + 1
Loop

'now process them
Do While i <= iLastRow

ReDim arydata(1 To 10, 1 To 2)

Do While .Cells(i, "A").Value <> ""

For j = 2 To 10

.Cells(i, j).Interior.ColorIndex = xlColorIndexNone
If .Cells(i, j).Value <> "" Then
If IsEmpty(arydata(j, 1)) Then
arydata(j, 1) = .Cells(i, j).Value
arydata(j, 2) = i
ElseIf .Cells(i, j).Value < arydata(j, 1) Then
arydata(j, 1) = .Cells(i, j).Value
arydata(j, 2) = i
End If
End If

Next j

i = i + 1

Loop

For j = 2 To 10

If Not IsEmpty(arydata(j, 1)) Then
.Cells(arydata(j, 2), j).Interior.ColorIndex = 6
End If

Next j

'move down to next data row
Do While .Cells(i, "A").Value = "" And i <= iLastRow
i = i + 1
Loop

Loop

End With

End Sub

ertan
03-05-2007, 08:09 AM
Problem solved by "XLD" 's solution.
Worked as expected.

Thank you all for your help