0
votes

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:

enter image description here

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?

enter image description here

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?

1
is that the only CF on the range? Also, you say column B formula is UNathan_Sav
@Nathan_Sav yeauser7415328
I think you've got the wrong column in your formulaNathan_Sav
@Nathan_Sav sorry labeled the column incorrectly. Its suppose to be U. see updated questionuser7415328

1 Answers

0
votes

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