using vba for conditional formatting

[QuizToon]

Hi all,

I have a table with 12 columns. I would like to highlight the highest and lowest entry in each column. Highest in green and the lowest in red.

there is a lot of copying and pasting which I find messes up the standard method so was wondering if VBA would work better

Many Thanks

 

[My Aswer Is This]

What is the name of the Table?

 

[lrobbo314]

This code will do the trick. There are different ways to set the range of your data table that might be better than 'CurrentRegion', but this should work. This will also take into account the possibility of having duplicate Min and Max values in a column.

Sub test()
Dim R As Range: Set R = Range("A1").CurrentRegion 'Change to first cell of where your data is
Dim AR As Variant: AR = R.Value
Dim TMP As Variant
Dim Low As Long
Dim High As Long


For i = 1 To UBound(AR, 2)
    TMP = Application.Index(AR, , i)
    Low = Application.WorksheetFunction.Min(TMP)
    High = Application.WorksheetFunction.Max(TMP)
        For j = 1 To UBound(TMP)
            If TMP(j, 1) = Low Then R.Cells(j, i).Interior.ColorIndex = 4
            If TMP(j, 1) = High Then R.Cells(j, i).Interior.ColorIndex = 3
        Next j
Next i


End Sub

 

[QuizToon]

Thanks for the reply

The sheet is called 2018

 

[QuizToon]

This code will do the trick. There are different ways to set the range of your data table that might be better than 'CurrentRegion', but this should work. This will also take into account the possibility of having duplicate Min and Max values in a column.

Sub test()
Dim R As Range: Set R = Range("A1").CurrentRegion 'Change to first cell of where your data is
Dim AR As Variant: AR = R.Value
Dim TMP As Variant
Dim Low As Long
Dim High As Long


For i = 1 To UBound(AR, 2)
    TMP = Application.Index(AR, , i)
    Low = Application.WorksheetFunction.Min(TMP)
    High = Application.WorksheetFunction.Max(TMP)
        For j = 1 To UBound(TMP)
            If TMP(j, 1) = Low Then R.Cells(j, i).Interior.ColorIndex = 4
            If TMP(j, 1) = High Then R.Cells(j, i).Interior.ColorIndex = 3
        Next j
Next i


End Sub

This didn't work - nothing happened

 

[My Aswer Is This]

I assume the answer in post 3 will work for you. No more help from me needed.
You said in your original post:

I have a table with 12 columns

I asked for the Table name not the sheet name.

A Table and a sheet are not the same.
​

Thanks for the reply

The sheet is called 2018

 

[QuizToon]

I assume the answer in post 3 will work for you. No more help from me needed.
You said in your original post:

I have a table with 12 columns

I asked for the Table name not the sheet name.

A Table and a sheet are not the same.
​

Sorry I did not realise.

The sheet is called 2018. In the sheet there 12 columns starting from cell C6 and running to N17

 

[Fluff]

How about

Sub MaxMinHilite()
   Dim i As Long
   For i = 3 To 14
      With Columns(i)
         Cells(Evaluate("match(max(" & .Address & ")," & .Address & ",0)"), i).Interior.Color = vbGreen
         Cells(Evaluate("match(min(" & .Address & ")," & .Address & ",0)"), i).Interior.Color = vbRed
      End With
   Next i
End Sub

EDIT:
If you have multiple max or min numbers in a column this will only highlight the first

 

[lrobbo314]

This didn't work - nothing happened

Did you read the code note and change where your data is? My code assumed it started in A1.

Now that I know where your data actually is, try this code.

Sub test()
Dim R As Range: Set R = Range("C6").CurrentRegion 'Change to first cell of where your data is
Dim AR As Variant: AR = R.Value
Dim TMP As Variant
Dim Low As Long
Dim High As Long


For i = 1 To UBound(AR, 2)
    TMP = Application.Index(AR, , i)
    Low = Application.WorksheetFunction.Min(TMP)
    High = Application.WorksheetFunction.Max(TMP)
        For j = 1 To UBound(TMP)
            If TMP(j, 1) = Low Then R.Cells(j, i).Interior.ColorIndex = 4
            If TMP(j, 1) = High Then R.Cells(j, i).Interior.ColorIndex = 3
        Next j
Next i


End Sub

 

[QuizToon]

Did you read the code note and change where your data is? My code assumed it started in A1.

Now that I know where your data actually is, try this code.

Sub test()
Dim R As Range: Set R = Range("C6").CurrentRegion 'Change to first cell of where your data is
Dim AR As Variant: AR = R.Value
Dim TMP As Variant
Dim Low As Long
Dim High As Long


For i = 1 To UBound(AR, 2)
    TMP = Application.Index(AR, , i)
    Low = Application.WorksheetFunction.Min(TMP)
    High = Application.WorksheetFunction.Max(TMP)
        For j = 1 To UBound(TMP)
            If TMP(j, 1) = Low Then R.Cells(j, i).Interior.ColorIndex = 4
            If TMP(j, 1) = High Then R.Cells(j, i).Interior.ColorIndex = 3
        Next j
Next i


End Sub

HI,

Yes I did change the cell reference, and I followed your code notes, but still nothing.

I also tried the code from the helper above and those didn’twork either. I a guessing there issomething wrong with my spreadsheet
Thanks for trying though, I suppose I will just have to usethe standard method and amend each time it changes


Regards all