Hi,
Hoping for some help please.
I am trying to use some VBA based on that posted here:
http://%22https//www.ozgrid.co…8#post905288%22
I've been bashing my head trying to get my VBA to work.
I have data which is grouped by date/time. Each group of date/time data has several columns of numerical values that I need to colour code (red to green) but I also need to highlight the top 2 and bottom 2 values e.g. with a Black border or change the text colour or something similar. I have found out how to colour code the data (from searching various forums) but when I try to highlight the top/bottom 2 using my code based on the code by https://www.ozgrid.com/forum/member/75013-yegarboy I keep getting errors.
Here's what I've got [INDENT]
Set rng = .Range(.Cells(i, k), .Cells(j, k))
For Each zCell In rng
If zCell = Application.WorksheetFunction.Large(rng, 1) Then
zCell.Interior.Color = vbGreen 'Color for Highest Value
GoTo NC
Else
zCell.Interior.ColorIndex = xlNone
End If
If zCell = Application.WorksheetFunction.Large(rng, 2) Then
zCell.Interior.Color = vbRed 'Color for 2nd Highest Value
GoTo NC
Else
zCell.Interior.ColorIndex = xlNone
End If
' ws.Columns("B:D").AutoFit 'Change Columns to AutoFit
NC:
Next
Display More
[/INDENT]
My full code with the Red to Green colour-coding is [INDENT]
Sub AV03_ColourTop()
'colour code each race data for Sm1 to end
Dim zCell As Range
Dim rng As Range
Dim lCol As Long
Dim lLastRow As Long
Dim ws As Worksheet
Range("A1").Select
Dim lo As ListObject, v As Variant
Dim i As Long, j As Long, k As Long, n As Long
Set lo = ActiveSheet.ListObjects(1)
'Convert text-time to serial time
lo.ListColumns(1).Range.Replace ":", ":"
lo.ListColumns(1).Range.NumberFormat = "hh:mm"
'Sort on date and time values
lo.Range.Sort lo.Range(1, 1), xlAscending, Header:=xlYes 'time
'Array of all Date-Time values
v = lo.DataBodyRange.Columns("A:A").value
i = 1: j = 1: n = 1
Do
DoEvents
'Find last row in date-time group
Do Until j = UBound(v, 1)
'add my ranking
Range("H" & j + 1).Select
ActiveCell.FormulaR1C1 = n
n = n + 1
If v(i, 1) <> v(j + 1, 1) Then Exit Do
j = j + 1
Loop
n = 1
For k = 10 To 50 'loop through columns 20 is Col T
'Apply conditional formatting for each filtered Date-Time-T3F_Column
With lo.DataBodyRange.Columns(k).Rows(i & ":" & j)
'.Select
.FormatConditions.Delete
With .FormatConditions.AddColorScale(ColorScaleType:=3)
'the low color is Red
With .ColorScaleCriteria(1)
' .FormatColor.Color = 0
.FormatColor.Color = 7039480
.Type = xlConditionValueLowestValue
End With
'the mid colors are yellow
With .ColorScaleCriteria(2)
.FormatColor.Color = 8711167
' .Type = xlConditionValueNumber
.Type = xlConditionValuePercentile
.value = 50
End With
'the high color is green
With .ColorScaleCriteria(3)
' .FormatColor.Color = 9109667
.FormatColor.Color = 8109667
.Type = xlConditionValueHighestValue
End With
End With
End With
With lo.DataBodyRange.Columns(k).Rows(i & ":" & j)
'.Select
'with worksheets("AVRA")
Set rng = .Range(.Cells(i, k), .Cells(j, k))
For Each zCell In rng
If zCell = Application.WorksheetFunction.Large(rng, 1) Then
zCell.Interior.Color = vbGreen 'Color for Highest Value
GoTo NC
Else
zCell.Interior.ColorIndex = xlNone
End If
If zCell = Application.WorksheetFunction.Large(rng, 2) Then
zCell.Interior.Color = vbRed 'Color for 2nd Highest Value
GoTo NC
Else
zCell.Interior.ColorIndex = xlNone
End If
' ws.Columns("B:D").AutoFit 'Change Columns to AutoFit
NC:
Next
' Next lCol
End With
Next k
i = j + 1: j = j + 1
Loop Until i > UBound(v, 1)
Application.ScreenUpdating = True
End Sub
Display More
[/INDENT]
I get the error message "Run-time ..1004. Unable to get the Large property of the WSFn class"
And the VBA highlights this section:
"If zCell = Application.WorksheetFunction.Large(rng, 1) Then"
NOTE: The code seems to run through once with k=10 as the some of the first date/time data gets colour-coded and some data also appears to get highlighted in bright green as shown in picture:
[ATTACH=JSON]{"data-align":"none","data-size":"full","title":"DB.jpg","data-attachmentid":1222915}[/ATTACH]
This pic is not how I want it to appear. I am just including it to show you what happens up to the error.
I'm no pro. Most of my code is cut and paste from forums so it may not be as elegant as it could be.
I'd be grateful for any suggestions as to why I get errors and also for any more elegant solutions to my code.
Thanks for taking the time to help.