Excel Conditional formatting not working? - excel

Question

I have a workbook like so:
Column A U
Supplier A 10
Supplier B 1
Supplier C 5
Supplier D 9
I am trying to highlight the entire row in red, only for the top 10 numbers in column B.
Here is my conditional formatting rule:
For some reaason the rows are only changing font colour, and the row is not highlighted. I reckon this has something to do with me turning off calculations?
My vba code includes:
Option Explicit
Sub code()
MsgBox "This will take upto 3 minutes."
Application.ScreenUpdating = False
Dim WB As Workbook
Dim i As Long
Dim j As Long
Dim Lastrow As Long
On Error Resume Next
Set WB = Workbooks("L.O. Lines Delivery Tracker.xlsm")
On Error GoTo 0
If WB Is Nothing Then 'open workbook if not open
Set WB = Workbooks.Open("G:\WH DISPO\(3) PROMOTIONS\(18) L.O. Delivery Tracking\L.O. Lines Delivery Tracker.xlsm")
End If
' ======= Edit #2 , also for DEBUG ======
With WB.Worksheets(1)
Lastrow = .Cells(.Rows.Count, "G").End(xlUp).Row
j = 2
For i = 7 To Lastrow
' === For DEBUG ONLY ===
Debug.Print CInt(ThisWorkbook.Worksheets(1).Range("F9").value)
Debug.Print Month(.Range("G" & i).value)
Debug.Print CInt(ThisWorkbook.Worksheets(1).Range("F10").value)
Debug.Print Year(.Range("G" & i).value)
Debug.Print ThisWorkbook.Worksheets(1).Range("B6").value
Debug.Print .Range("M" & i).value
If CInt(ThisWorkbook.Worksheets(1).Range("F9").value) = Month(.Range("G" & i).value) Then ' check if Month equals the value in "A1"
If CInt(ThisWorkbook.Worksheets(1).Range("F10").value) = Year(.Range("G" & i).value) Then ' check if Year equals the value in "A2"
If ThisWorkbook.Worksheets(1).Range("B6").value = .Range("M" & i).value Then
ThisWorkbook.Worksheets(2).Range("A" & j).value = .Range("G" & i).value
ThisWorkbook.Worksheets(2).Range("B" & j).Formula = "=MONTH(B" & j & ")"
ThisWorkbook.Worksheets(2).Range("C" & j).value = .Range("L" & i).value
ThisWorkbook.Worksheets(2).Range("D" & j).value = .Range("D" & i).value
ThisWorkbook.Worksheets(2).Range("E" & j).value = .Range("E" & i).value
ThisWorkbook.Worksheets(2).Range("F" & j).value = .Range("F" & i).value
ThisWorkbook.Worksheets(2).Range("g" & j).value = .Range("p" & i).value
ThisWorkbook.Worksheets(2).Range("H" & j).value = .Range("H" & i).value
ThisWorkbook.Worksheets(2).Range("I" & j).value = .Range("I" & i).value
ThisWorkbook.Worksheets(2).Range("J" & j).value = .Range("J" & i).value
ThisWorkbook.Worksheets(2).Range("k" & j).value = .Range("Q" & i).value
ThisWorkbook.Worksheets(2).Range("L" & j).value = .Range("m" & i).value
j = j + 1
End If
End If
End If
Next i
End With
Worksheets(1).UsedRange.Columns("B:AA").Calculate
On Error GoTo Message
With ThisWorkbook.Worksheets(1) '<--| change "mysheet" to your actual sheet name
Intersect(.Range(Rows(14), .UsedRange.Rows(.UsedRange.Rows.Count)), .Range("G:G")).WrapText = True
Intersect(.Range(Rows(14), .UsedRange.Rows(.UsedRange.Rows.Count)), .Range("G:G")).EntireRow.AutoFit
End With
'End
Application.ScreenUpdating = True
Exit Sub
Message:
On Error Resume Next
Exit Sub
End Sub
And
Private Sub Worksheet_Change(ByVal Target As Range)
Application.Calculation = xlManual
Application.CalculateBeforeSave = False
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.Calculation = xlManual
Application.CalculateBeforeSave = False
End Sub
And
Private Sub Workbook_Open()
Application.Calculation = xlManual
Application.CalculateBeforeSave = False
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.Calculation = xlManual
Application.CalculateBeforeSave = False
End Sub
Please can someone show me where i am going wrong?

Answer 1

Please try:
Sub CF()
Cells.Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND($B1>=LARGE($B:$B,10),ROW()<>1)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1)
.Interior.Color = 255
.StopIfTrue = False
End With
End Sub