VBA Excel - Row cells locking/unlocking using Conditional formatting?

Question

---

Hi, my sheet has 103 columns and 18550 rows of data which is coming from database. Based on B column cells value i have to apply formatting for the respective row like [if B2 value is 1 then for that row interior color should be Orange in color else if it is -1 then it should be in Blue else if it is 0 then the columns F & G should be Green in color and these green coloured cells should not be locked. And every 1 valued row and the immediate -1 valued rows should be grouped. Currently i have the following code which is almost taking 8 minutes of time to apply formattings.

---

With ThisWorkBook.Sheets("RoAe").Range("A1:A" & rowLen)

'=================For 1 valued Rows==========
Set C = .Find("1", LookIn:=xlValues)
x=0
If Not C Is Nothing Then
    firstAddress = C.Address
    Do
            valR = Split(C.Address, "$")
            actVal = valR(2)
            ReDim Preserve HArray(x)
            HArray(x) = actVal + 1
            x = x + 1


            With ThisWorkBook.Sheets("RoAe").Range("D" & actVal & ":FN" & actVal)
                .Rows.AutoFit
                .WrapText = True
                .Font.Bold = True
                .Interior.Color = RGB(252,213,180) 
                .Borders.Color = RGB(0, 0, 0)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With

            Set C = .FindNext(C)
    Loop While Not C Is Nothing And C.Address <> firstAddress
End If


'=================For -1 valued Rows==========
Set C = .Find("-1", LookIn:=xlValues)
y=0
If Not C Is Nothing Then
    firstAddress = C.Address
    Do
            valR = Split(C.Address, "$")
            actVal = valR(2)
            ReDim Preserve HArray(y)
            FArray(y) = actVal + 1
            y = y + 1


            With ThisWorkBook.Sheets("RoAe").Range("D" & actVal & ":FN" & actVal)
                .Rows.AutoFit
                .WrapText = True
                .Font.Bold = True
                .Interior.Color = RGB(141,180,226) 
                .Borders.Color = RGB(0, 0, 0)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With

            Set C = .FindNext(C)
    Loop While Not C Is Nothing And C.Address <> firstAddress
End If


'===================For 0(Zero) Valued Rows============
For p = 0 To UBound(HArray)
    groupRange = "A" & HArray(p) & ":A" & FArray(p)     
    For i = 0 To UBound(arrUnlockMonthStart)
        unlockRange = F & (HArray(p) + 1) & ":" & G & FArray(p)                                                      
        ThisWorkBook.Sheets("RoAe").Range(unlockRange).Locked = False
        ThisWorkBook.Sheets("RoAe").Range(unlockRange).Interior.Color = RGB(216,228,188)
    Next
next

end with
ThisWorkBook.Sheets("RoAe").protect "12345"

---

Can we do the same with Conditional Formatting. Applying format & locking/unlocking for the rows based on cell value. Any help would be appreciated greatly.

Answer 1

As i mentioned that you cannot lock/unlock a cell in conditional formatting. You will have to first apply the conditional formatting and then lock/unlock the cells. Also you do not need to loop to apply conditional formatting. You can do that in one go.

Try this

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long, i As Long
    Dim Rng As Range, unlockRng As Range

    '~~> Set this to the relevant worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        '~~> Find the last row in Col B
        lRow = .Range("B" & .Rows.Count).End(xlUp).Row

        '~~> Set your range where CF will be applied for -1/1
        Set Rng = .Range("D2:H" & lRow)

        With Rng
            .FormatConditions.Add Type:=xlExpression, Formula1:="=$B2=1"
            .FormatConditions(1).SetFirstPriority
            With .FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent6
                .TintAndShade = 0.399945066682943 '<~~ Orange
            End With
            .FormatConditions(1).StopIfTrue = True

            .FormatConditions.Add Type:=xlExpression, Formula1:="=$B2=-1"
            .FormatConditions(2).SetFirstPriority
            With .FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorLight2
                .TintAndShade = 0.599993896298105 '<~~ Blue
            End With
            .FormatConditions(1).StopIfTrue = True
         End With

         '~~> Set your range where CF will be applied for 0
         Set Rng = .Range("F2:G" & lRow)

         With Rng
            .FormatConditions.Add Type:=xlExpression, Formula1:="=$B2=0"
            .FormatConditions(3).SetFirstPriority
            With .FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent3
                .TintAndShade = 0.399975585192419 '<~~ Green
            End With
            .FormatConditions(1).StopIfTrue = True
         End With

         '~~> Loop through cells in Col B to checl for 0 and store
         '~~> relevant Col F and G in a range
         For i = 2 To lRow
            If .Range("B" & i).Value = 0 Then
                If unlockRng Is Nothing Then
                    Set unlockRng = .Range("F" & i & ":G" & i)
                Else
                    Set unlockRng = Union(unlockRng, .Range("F" & i & ":G" & i))
                End If
            End If
         Next i
    End With

    '~~> unlock the range in one go
    If Not unlockRng Is Nothing Then unlockRng.Locked = False
End Sub

ScreenShot

EDIT

For 103 Columns and 18550 Rows use this method. This is much faster than the above

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long, i As Long
    Dim Rng As Range, unlockRng As Range

    '~~> Set this to the relevant worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    Application.ScreenUpdating = False

    With ws
        '~~> Find the last row in Col B
        lRow = .Range("B" & .Rows.Count).End(xlUp).Row

        '~~> Set your range where CF will be applied for -1/1
        '~~> Taking 103 Columns into account
        Set Rng = .Range("D2:DB" & lRow)

        With Rng
            .Locked = True

            .FormatConditions.Delete

            .FormatConditions.Add Type:=xlExpression, Formula1:="=$B2=1"
            .FormatConditions(1).SetFirstPriority
            With .FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent6
                .TintAndShade = 0.399945066682943 '<~~ Orange
            End With
            .FormatConditions(1).StopIfTrue = True

            .FormatConditions.Add Type:=xlExpression, Formula1:="=$B2=-1"
            .FormatConditions(2).SetFirstPriority
            With .FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorLight2
                .TintAndShade = 0.599993896298105 '<~~ Blue
            End With
            .FormatConditions(1).StopIfTrue = True
         End With

         '~~> Set your range where CF will be applied for 0
         Set Rng = .Range("F2:G" & lRow)

         With Rng
            .FormatConditions.Add Type:=xlExpression, Formula1:="=$B2=0"
            .FormatConditions(3).SetFirstPriority
            With .FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent3
                .TintAndShade = 0.399975585192419 '<~~ Green
            End With
            .FormatConditions(1).StopIfTrue = True
         End With

         '~~> Loop through cells in Col B to check for 0 and 
         '~~> unlock the relevant range
         For i = 2 To lRow
            If .Range("B" & i).Value = 0 Then
                .Range("F" & i & ":G" & i).Locked = False
            End If
         Next i
    End With

    Application.ScreenUpdating = True
End Sub

Answer 2

As far as I know, the locking and grouping cannot be done with Conditional Formatting, the coloring however can be done.

You can color a cell based o a formula entered in conditional formatting dialog and this formula can contain relative, semi-relative and absolute references to other cells (using the $ notation as in any other formulas).

For example the "make row orange if column B = 1" can be done by setting condition formatting in cell D2 to formula =if($B1=1;TRUE;FALSE). If you put the $ in front of B as in this example, than you can apply the conditional formatting to the whole range columns D:H and it should color the lines as your script does.

Doing all the colors is just repeating the process and setting more conditional formating rules with different formulas.