Identical Min

[billandrew]

Good Morning

The code below highlights the Minimum value in Columns 1 to 4, Rows = Array. Currently working with only one issue. If there is an identical Min value in the specific range the first min value will be the only value highlighted. Stumped on how to highlight both or all identical min values.

Thank You for any assist..

Sub MinRange()

        Dim Rng As Range, Min As Range, R As Range, Col As Long, Rw As Variant, n As Long
        For Col = 1 To 4
        
        Rw = Array(1, 12, 13, 24)
        For n = 0 To UBound(Rw) Step 2
        Set Rng = Range(Cells(Rw(n), Col), Cells(Rw(n + 1), Col))
    
        Set R = Rng(1)
            
        For Each Min In Rng
        If Min.Value < R.Value Then Set R = Min
        Next Min
        
        R.Interior.Color = RGB(253, 249, 215)
        R.Font.Color = RGB(192, 0, 0)
        R.Font.Bold = True
        
        Next
        Next Col


        End Sub

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG21Aug53
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Min [COLOR="Navy"]As[/COLOR] Range, R [COLOR="Navy"]As[/COLOR] Double, Col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Rw [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
    
    [COLOR="Navy"]For[/COLOR] Col = 1 To 4
             Rw = Array(1, 12, 13, 24)
                [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Rw) [COLOR="Navy"]Step[/COLOR] 2
                    [COLOR="Navy"]Set[/COLOR] Rng = Range(Cells(Rw(n), Col), Cells(Rw(n + 1), Col))
                        R = Application.Min(Rng)
        
                    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Min [COLOR="Navy"]In[/COLOR] Rng
                        [COLOR="Navy"]If[/COLOR] Min.Value = R [COLOR="Navy"]Then[/COLOR]
                            Min.Interior.Color = RGB(253, 249, 215)
                            Min.Font.Color = RGB(192, 0, 0)
                            Min.Font.Bold = True
                        [COLOR="Navy"]End[/COLOR] If
                [COLOR="Navy"]Next[/COLOR] Min
            [COLOR="Navy"]Next[/COLOR] n
      [COLOR="Navy"]Next[/COLOR] Col
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[billandrew]

Works GREAT!

If you could explain how?

Thank You sir

 

[MickG]

This may help !!!

[COLOR="Navy"]Sub[/COLOR] MG21Aug48
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Min [COLOR="Navy"]As[/COLOR] Range, R [COLOR="Navy"]As[/COLOR] Double, Col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Rw [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
    '[COLOR="Green"][B]loop through each column[/B][/COLOR]
    [COLOR="Navy"]For[/COLOR] Col = 1 To 4
             Rw = Array(1, 12, 13, 24)
                
                '[COLOR="Green"][B]Loop through each range in each column[/B][/COLOR]
                [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Rw) [COLOR="Navy"]Step[/COLOR] 2
                    
                    '[COLOR="Green"][B]set each  range of cells as below[/B][/COLOR]
                    [COLOR="Navy"]Set[/COLOR] Rng = Range(Cells(Rw(n), Col), Cells(Rw(n + 1), Col))
                        
                        '[COLOR="Green"][B]Find minimum value in each column and assign R as minimum value[/B][/COLOR]
                        R = Application.Min(Rng)
        
                    '[COLOR="Green"][B]Loop through each column, when a (Min) match is found color the cells[/B][/COLOR]
                    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Min [COLOR="Navy"]In[/COLOR] Rng
                        [COLOR="Navy"]If[/COLOR] Min.Value = R [COLOR="Navy"]Then[/COLOR]
                            Min.Interior.Color = RGB(253, 249, 215)
                            Min.Font.Color = RGB(192, 0, 0)
                            Min.Font.Bold = True
                        [COLOR="Navy"]End[/COLOR] If
                [COLOR="Navy"]Next[/COLOR] Min
            [COLOR="Navy"]Next[/COLOR] n
      [COLOR="Navy"]Next[/COLOR] Col
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[billandrew]

Awesome

Can't Thank You enough Mick...

 

[MickG]

You're welcome