Conditional Formatting removal

[sharpeye]

Hi everyone
I am having difficulties using some code I got on a a thread to replce conditional formatting with the result of the conditional formatting, I needed to use this as leaving the formatting in place was draining the resources on my laptop. The code I found did work and I managed to get it to activate using ctrl+shift+n and everything was great.
A while ago something happened, I have no idea what, I couldnt get it to work and after a lot of messing around I cant even remember how I applied the code to the ctrl+shift+n
What I have just tried is go use Record Macro, assign the shift+n and stop recording and then paste the code in using the edit button but I keep getting "Expected End Sub" when I try to run or debug. I have very little knowledge of VBA.
This is the code I am using, its probably something very simple (I hope)
Any ideas?

Sub CFR()
'
' CFR Macro
' Conditional Formatting Removal
'
' Keyboard Shortcut: Ctrl+Shift+N
'
' PGC Nov 06
' Delinks formats from conditions in cells with conditional formatting.
' The cells keep the format that was enabled with the conditional formatting
' but as normal format.
Sub ConditionalFormatDelink(rRng As Range)
Dim vConditionsSyntax, rCell As Range, rCFormat As Range, iCondition As Integer
Dim sFormula As String, vCSyntax, vOperator

' Syntax for "Value is" Conditions
vConditionsSyntax = Array( _
Array(xlEqual, "CellRef = Condition1"), _
Array(xlNotEqual, "CellRef <> Condition1"), _
Array(xlLess, "CellRef < Condition1"), _
Array(xlLessEqual, "CellRef <= Condition1"), _
Array(xlGreater, "CellRef > Condition1"), _
Array(xlGreaterEqual, "CellRef >= Condition1"), _
Array(xlBetween, "AND(CellRef >= Condition1, CellRef <= Condition2)"), _
Array(xlNotBetween, "OR(CellRef < Condition1, CellRef > Condition2)") _
)

' Get cells with format
On Error GoTo EndSub
Set rCFormat = rRng.SpecialCells(xlCellTypeAllFormatConditions)

On Error Resume Next
For Each rCell In rCFormat ' Loops through all the cells with conditional formatting
If Not IsError(rCell) Then ' skips cells with error
rCell.Activate
With rCell.FormatConditions
For iCondition = 1 To .Count ' loops through all the conditions
sFormula = .Item(iCondition).Formula1
Err.Clear
vOperator = .Item(iCondition).Operator
If Err <> 0 Then ' "Formula Is"
Err.Clear
Else ' "Value Is"
For Each vCSyntax In vConditionsSyntax ' checks all the condition types
If .Item(iCondition).Operator = vCSyntax(0) Then
' build the formula equivalent to the condition
sFormula = Replace(vCSyntax(1), "Condition1", sFormula)
sFormula = Replace(sFormula, "CellRef", rCell.Address)
sFormula = Replace(sFormula, "Condition2", .Item(iCondition).Formula2)
Exit For
End If
Next vCSyntax
End If
If Evaluate(sFormula) Then
' The cell has a condition = True. Delink the format from the conditional formatting
rCell.Font.ColorIndex = .Item(iCondition).Font.ColorIndex
rCell.Interior.ColorIndex = .Item(iCondition).Interior.ColorIndex
Exit For ' if one condition is true skips the next ones
End If
Next iCondition
End With
End If
rCell.FormatConditions.Delete ' deletes the cell's conditional formatting
Next rCell
EndSub:
End Sub

End Sub

Many thanks

 

[Norie]

Here's a link to the thread the code came from https://www.mrexcel.com/forum/excel...conditional-formatting-into-standard-one.html.

 

[sharpeye]

Thank you. I have already posted in that thread just short of a month ago the same kind of cry for help but have not any resopnse. I dont think there is any problem with the code at all, just how to run the code under the keyboard shortcut

 

[Norie]

What code did you have assigned to the shortcut?

 

[sharpeye]

The code in my origonal post is what I am using and trying to assign to keyboard shortcut ctrl+shift+n. After a bit of looking around I have found that the code above has 2 "Sub" commands which doesnt help. I have removed one of those but its still not working.

I hava also tried to use an OnKey command but that doesnt seem to help either

 

[sharpeye]

This is what I have at this time

Sub CFR()
Dim vConditionsSyntax, rCell As Range, rCFormat As Range, iCondition As Integer
Dim sFormula As String, vCSyntax, vOperator

' Syntax for "Value is" Conditions
vConditionsSyntax = Array( _
Array(xlEqual, "CellRef = Condition1"), _
Array(xlNotEqual, "CellRef <> Condition1"), _
Array(xlLess, "CellRef < Condition1"), _
Array(xlLessEqual, "CellRef <= Condition1"), _
Array(xlGreater, "CellRef > Condition1"), _
Array(xlGreaterEqual, "CellRef >= Condition1"), _
Array(xlBetween, "AND(CellRef >= Condition1, CellRef <= Condition2)"), _
Array(xlNotBetween, "OR(CellRef < Condition1, CellRef > Condition2)") _
)

' Get cells with format
On Error GoTo EndSub
Set rCFormat = rRng.SpecialCells(xlCellTypeAllFormatConditions)

On Error Resume Next
For Each rCell In rCFormat ' Loops through all the cells with conditional formatting
If Not IsError(rCell) Then ' skips cells with error
rCell.Activate
With rCell.FormatConditions
For iCondition = 1 To .Count ' loops through all the conditions
sFormula = .Item(iCondition).Formula1
Err.Clear
vOperator = .Item(iCondition).Operator
If Err <> 0 Then ' "Formula Is"
Err.Clear
Else ' "Value Is"
For Each vCSyntax In vConditionsSyntax ' checks all the condition types
If .Item(iCondition).Operator = vCSyntax(0) Then
' build the formula equivalent to the condition
sFormula = Replace(vCSyntax(1), "Condition1", sFormula)
sFormula = Replace(sFormula, "CellRef", rCell.Address)
sFormula = Replace(sFormula, "Condition2", .Item(iCondition).Formula2)
Exit For
End If
Next vCSyntax
End If
If Evaluate(sFormula) Then
' The cell has a condition = True. Delink the format from the conditional formatting
rCell.Font.ColorIndex = .Item(iCondition).Font.ColorIndex
rCell.Interior.ColorIndex = .Item(iCondition).Interior.ColorIndex
Exit For ' if one condition is true skips the next ones
End If
Next iCondition
End With
End If
rCell.FormatConditions.Delete ' deletes the cell's conditional formatting
Next rCell
EndSub:
End Sub

 

[Norie]

What range do you want to remove the conditional formatting from?

 

[sharpeye]

Everything inside an area that is highlight using my cursor, could be a few rows or a few pages but all of this did work perfectly when I first put the macro into my excel sheet in October. I did create a few more Macros that work with different worksheets and all I can think as to why this stopped working is if somehow while putting together my other Macro's if I may have possibly deleted something or caused some other kind of issue, I just cant figure out how I managed to get it to work with no problems whatsoever at my firs attempt back in October but I cant get it working now after nearly a month from when it went wrong

 

[Norie]

Try this.

1 Open the VBE with ALT+F11.

2 Insert a new module (Insert>Module).

3 Paste this code in the new module.

Option Explicit

Sub ConditionalFormatDelink(rRng As Range)

Dim vConditionsSyntax, rCell As Range, rCFormat As Range, iCondition As Integer
Dim sFormula As String, vCSyntax, vOperator
    
' Syntax for "Value is" Conditions
    vConditionsSyntax = Array( _
    Array(xlEqual, "CellRef = Condition1"), _
    Array(xlNotEqual, "CellRef <> Condition1"), _
    Array(xlLess, "CellRef < Condition1"), _
    Array(xlLessEqual, "CellRef <= Condition1"), _
    Array(xlGreater, "CellRef > Condition1"), _
    Array(xlGreaterEqual, "CellRef >= Condition1"), _
    Array(xlBetween, "AND(CellRef >= Condition1, CellRef <= Condition2)"), _
    Array(xlNotBetween, "OR(CellRef < Condition1, CellRef > Condition2)") _
    )
    
' Get cells with format
    On Error GoTo EndSub
    Set rCFormat = rRng.SpecialCells(xlCellTypeAllFormatConditions)
    
    On Error Resume Next
    For Each rCell In rCFormat ' Loops through all the cells with conditional formatting
        If Not IsError(rCell) Then ' skips cells with error
            rCell.Activate
            With rCell.FormatConditions
                For iCondition = 1 To .Count ' loops through all the conditions
                    sFormula = .Item(iCondition).Formula1
                    Err.Clear
                    vOperator = .Item(iCondition).Operator
                    
                    If Err <> 0 Then ' "Formula Is"
                        Err.Clear
                    Else ' "Value Is"
                        For Each vCSyntax In vConditionsSyntax ' checks all the condition types
                            If .Item(iCondition).Operator = vCSyntax(0) Then
                ' build the formula equivalent to the condition
                                sFormula = Replace(vCSyntax(1), "Condition1", sFormula)
                                sFormula = Replace(sFormula, "CellRef", rCell.Address)
                                sFormula = Replace(sFormula, "Condition2", .Item(iCondition).Formula2)
                                Exit For
                            End If
                        Next vCSyntax
                    End If
                        
                    If Evaluate(sFormula) Then
                    ' The cell has a condition = True. Delink the format from the conditional formatting
                        rCell.Font.ColorIndex = .Item(iCondition).Font.ColorIndex
                        rCell.Interior.ColorIndex = .Item(iCondition).Interior.ColorIndex
                        Exit For ' if one condition is true skips the next ones
                    End If
                    
                Next iCondition
                
            End With
        End If
    
        rCell.FormatConditions.Delete ' deletes the cell's conditional formatting
        
    Next rCell
    
EndSub:

End Sub

4 In the same module, below the above code paste this.

Sub ClearCF()
    ConditionalFormatDelink Selection
End Sub

5 Open the Macro dialog with ALT+F8.

6 Select ClearCF from the list and click Options...

7 Enter N in the shortcut key box and click OK.

8 Click Cancel.

You should now be able to run the code to remove conditional formatting using the shortcut CTRL+SHIFT+N.

 

[sharpeye]

Thank you thats done the trick. Im a little puzzled as that isnt how I did it when it was working before but hey, its working now so im delighted.
Thank you ever so much. Have a wonderful day =)