Hello All
The attached macro will only work on Sheet 1,is it possible to modify it to work on any worksheet.
Many thanks for help given.

Sub ColorMinMaxRates()

'Revised to color min and max in group's columns

Dim GroupName As String
Dim GroupRng As Range
Dim i As Long, j As Long
Dim MaxRate As Double
Dim MinRate As Double
Dim NextName As String
Dim R As Long
Dim Rng As Range
Dim RngEnd As Range
Dim StartRow As Long
Dim wks As Worksheet

Set wks = Worksheets("Sheet1")
Set Rng = wks.Range("A2:AP2")

Set RngEnd = wks.Cells(Rows.Count, Rng.Column).End(xlUp)
If RngEnd.Row < Rng.Row Then Exit Sub

Set Rng = Rng.Resize(RowSize:=RngEnd.Row - Rng.Row + 1)

Application.ScreenUpdating = False

StartRow = 1

For R = 1 To Rng.Rows.Count

GroupName = Rng.Item(R, 1) & Rng.Item(R, 4) & Rng.Item(R, 5)
NextName = Rng.Item(R + 1, 1) & Rng.Item(R + 1, 4) & Rng.Item(R + 1, 5)

If GroupName <> NextName Then
Set GroupRng = Rng.Item(StartRow, 6).Resize(R - StartRow + 1, 5)

For i = 11 To 21

MinRate = WorksheetFunction.Min(GroupRng.Columns(i))
MaxRate = WorksheetFunction.Max(GroupRng.Columns(i))
For j = 1 To GroupRng.Rows.Count
Select Case GroupRng.Item(j, i)
Case MinRate
GroupRng.Item(j, i).Font.Color = vbGreen
Case MaxRate
GroupRng.Item(j, i).Font.Color = vbRed
End Select
Next j
Next i

StartRow = R + 1
End If

Next R

Application.ScreenUpdating = True

End Sub