Need to select and highlight non-contiguous cells based on minimum value

[ouadad]

I've done some calculations where the output consists of 6 scenarios of 6000 rows of results in 12 separate worksheets. The output for each scenario looks like this, where columns B,C,D would contain values for RMSE, MAE and MASE for scenario 1 and columns G,H,I would contain the values for scenario 2, etc, for 6000 rows and 6 scenarios. What I would like to do is compare the values for RMSE in each row, find the minimum value and highlight the cell. Then do the same for MAE and MASE. The problem is the cells aren't contiguous so a Range over all the cells in the row won't give me what I want.

SES	RMSE	MAE	MASE		Mean	RMSE	MAE	MASE		Naive	RMSE	MAE	MASE
Test	8.331	8.331	0.458		Test	8.333	8.333	0.545		Test	0	0	0
Test	0.333	0.333	0.458		Test	0.333	0.333	0.6		Test	0	0	0
Test	2	2	0.512		Test	2	2	0.667		Test	2	2	0.512
Test	32.086	32.086	0.528		Test	32.083	32.083	0.75		Test	0	0	0
Test	0.417	0.417	0.458		Test	0.417	0.417	0.6		Test	0	0	0
Test	6.505	6.505	1.988		Test	3	3	0.667		Test	20	20	6.111
Test	0.167	0.167	0.458		Test	0.167	0.167	0.545		Test	0	0	0

I've written some code below just for the RMSE calculation just for the first three rows, but the rng search doesn't give me what I need.

Sub Highlight_Minimum_Metric()
Dim totalrows As Long, irow As Long, minRMSE As Double, rng As Range, cell As Range
totalrows = Sheets("h=1").UsedRange.Rows.Count
For irow = 2 To 4
    Set rng = Range(Cells(irow, 2), Cells(irow, 29))
     minRMSE = Application.WorksheetFunction.Min(Cells(irow, 2), Cells(irow, 7), Cells(irow, 22), Cells(irow, 27))
    For Each cell In rng
        If cell.Value = minRMSE Then
            cell.Font.Color = vbRed
         End If
        Next cell
Next irow
End Sub

 

[Peter_SSs]

This is done with Conditional Formatting. Does it do what you want?
- If so, it could be applied with vba if required.
- If not, what should be highlighted & why?

I selected B2:N8 and then set the Conditional Formatting formula rules.
This uses the MINIFS function which is only available in recent versions of Excel. If you don't have MINIFS but this is the result you want, post back for an alternative & state what Excel version you are using.

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	SES	RMSE	MAE	MASE		Mean	RMSE	MAE	MASE		Naive	RMSE	MAE	MASE
2	Test	8.331	8.331	0.458		Test	8.333	8.333	0.545		Test	0	0	0
3	Test	0.333	0.333	0.458		Test	0.333	0.333	0.6		Test	0	0	0
4	Test	2	2	0.512		Test	2	2	0.667		Test	2	2	0.512
5	Test	32.086	32.086	0.528		Test	32.083	32.083	0.75		Test	0	0	0
6	Test	0.417	0.417	0.458		Test	0.417	0.417	0.6		Test	0	0	0
7	Test	6.505	6.505	1.988		Test	3	3	0.667		Test	20	20	6.111
8	Test	0.167	0.167	0.458		Test	0.167	0.167	0.545		Test	0	0	0
Min

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
B2	1. / Formula is =AND(B$1="MASE",B2=MINIFS($B2:$N2,$B$1:$N$1,"MASE"))	Abc
B2	2. / Formula is =AND(B$1="MAE",B2=MINIFS($B2:$N2,$B$1:$N$1,"MAE"))	Abc
B2	3. / Formula is =AND(B$1="RMSE",B2=MINIFS($B2:$N2,$B$1:$N$1,"RMSE"))	Abc

 

[ouadad]

Peter, I'd really like to do it with VBA. I have 12 worksheets and each has six scenarios with 6000 rows. I know I can do it with conditional formatting, but I would rather do it through a macro.

 

[ouadad]

I'm also only using Excel 2010, so no MINIFS function.

 

[Peter_SSs]

Peter, I'd really like to do it with VBA. I have 12 worksheets

I'm not sure if they are the only worksheets in your workbook? The code below is written to act on all sheets in the workbook, so if you have others, we need some detail to determine which ones to do and which ones to leave alone.

Also, I have not tested on any large data, so I would suggest trying with smallish sets of data to start with - & not any workbook that does not have a backup.

Sub Highlight_Minimums()
  Dim a As Variant, aRMSE As Variant, aMAE As Variant, aMASE As Variant, c As Variant, aCols As Variant, aColors As Variant
  Dim ws As Worksheet
  Dim h As Long, i As Long
  Dim dMin As Double
  
  aColors = Array(vbGreen, vbCyan, vbYellow)
  For Each ws In Worksheets
    With ws.UsedRange
      a = .Value
      ReDim aRMSE(0): ReDim aMAE(0): ReDim aMASE(0)
      For i = 1 To UBound(a, 2)
        Select Case a(1, i)
          Case "RMSE": ReDim Preserve aRMSE(1 To UBound(aRMSE) + 1): aRMSE(UBound(aRMSE)) = i
          Case "MAE": ReDim Preserve aMAE(1 To UBound(aMAE) + 1): aMAE(UBound(aMAE)) = i
          Case "MASE": ReDim Preserve aMASE(1 To UBound(aMASE) + 1): aMASE(UBound(aMASE)) = i
        End Select
      Next i
      aCols = Array(aRMSE, aMAE, aMASE)
      For i = 2 To UBound(a)
        For h = LBound(aCols) To UBound(aCols)
          dMin = Application.Min(Application.Index(a, i, aCols(h)))
          For Each c In aCols(h)
            If a(i, c) = dMin Then .Cells(i, c).Interior.Color = aColors(h)
          Next c
        Next h
      Next i
    End With
  Next ws
End Sub