-1

I browsed through Make conditional formatting static and it appears that the code no longer works with Office 19.

At the line of code

Set objFormatCondition = rgeCell.FormatConditions(iconditionscount)

It shows

runtime error 13 - Type Mismatch

Option Explicit
    
Sub FreezeConditionalFormattingOnSelection()
    Call FreezeConditionalFormatting(Selection)
    Selection.FormatConditions.Delete
End Sub
    
Public Function FreezeConditionalFormatting(rng As Range)
    Rem Originally posted by http://stackoverflow.com/users/353410/belisarius
    Rem at http://stackoverflow.com/questions/4692918/excel-make-conditional-formatting-static
    Rem Modified 2012-04-20 by gcl to:
    Rem   (a) be a function taking target range as an argument, and
    Rem   (b) to cancel any multiple selection before processing in order to work around a bug
    Rem         in Excel 2003 wherein querying the formula on any cell in a multiple/extended selection
    Rem         returns the conditional formatting on the first cell in that selection!
    Rem   (c) return number of cells that it modified.
    
    Dim iconditionno As Integer
    Dim rgeCell As Range
    Dim nCFCells As Integer
    Dim rgeOldSelection As Range
    
    Set rgeOldSelection = Selection 'new
    
    nCFCells = 0
    For Each rgeCell In rng
        rgeCell.Select  'new
    
       If rgeCell.FormatConditions.Count <> 0 Then
           iconditionno = ConditionNo(rgeCell)
           If iconditionno <> 0 Then
               rgeCell.Interior.ColorIndex = rgeCell.FormatConditions(iconditionno).Interior.ColorIndex
               rgeCell.Font.ColorIndex = rgeCell.FormatConditions(iconditionno).Font.ColorIndex
               nCFCells = nCFCells + 1
           End If
       End If
    Next rgeCell
    
    rgeOldSelection.Select 'new
    
    FreezeConditionalFormatting = nCFCells
End Function
    
Private Function ConditionNo(ByVal rgeCell As Range) As Integer
    Rem posted by http://stackoverflow.com/users/353410/belisarius
    Rem at http://stackoverflow.com/questions/4692918/excel-make-conditional-formatting-static
    
    Dim iconditionscount As Integer
    Dim objFormatCondition As FormatCondition
    
    For iconditionscount = 1 To rgeCell.FormatConditions.Count
        Set objFormatCondition = rgeCell.FormatConditions(iconditionscount)
        Select Case objFormatCondition.Type
            Case xlCellValue
                Select Case objFormatCondition.Operator
                    Case xlBetween: If Compare(rgeCell.Value, ">=", objFormatCondition.Formula1) = True And _
                                               Compare(rgeCell.Value, "<=", objFormatCondition.Formula2) = True Then _
                                               ConditionNo = iconditionscount
    
                    Case xlNotBetween: If Compare(rgeCell.Value, "<=", objFormatCondition.Formula1) = True And _
                                               Compare(rgeCell.Value, ">=", objFormatCondition.Formula2) = True Then _
                                               ConditionNo = iconditionscount
    
                    Case xlGreater: If Compare(rgeCell.Value, ">", objFormatCondition.Formula1) = True Then _
                                               ConditionNo = iconditionscount
    
                    Case xlEqual: If Compare(rgeCell.Value, "=", objFormatCondition.Formula1) = True Then _
                                               ConditionNo = iconditionscount
    
                    Case xlGreaterEqual: If Compare(rgeCell.Value, ">=", objFormatCondition.Formula1) = True Then _
                                               ConditionNo = iconditionscount
    
                    Case xlLess: If Compare(rgeCell.Value, "<", objFormatCondition.Formula1) = True Then _
                                               ConditionNo = iconditionscount
    
                    Case xlLessEqual: If Compare(rgeCell.Value, "<=", objFormatCondition.Formula1) = True Then _
                                               ConditionNo = iconditionscount
    
                    Case xlNotEqual: If Compare(rgeCell.Value, "<>", objFormatCondition.Formula1) = True Then _
                                               ConditionNo = iconditionscount
    
                    If ConditionNo > 0 Then Exit Function
                End Select
    
            Case xlExpression
                If Application.Evaluate(objFormatCondition.Formula1) Then
                   ConditionNo = iconditionscount
                   Exit Function
                End If
        End Select
    
    Next iconditionscount
End Function
    
Private Function Compare(ByVal vValue1 As Variant, _
                         ByVal sOperator As String, _
                         ByVal vValue2 As Variant) As Boolean
    
    If Left(CStr(vValue1), 1) = "=" Then vValue1 = Application.Evaluate(vValue1)
    If Left(CStr(vValue2), 1) = "=" Then vValue2 = Application.Evaluate(vValue2)
    
    If IsNumeric(vValue1) = True Then vValue1 = CDbl(vValue1)
    If IsNumeric(vValue2) = True Then vValue2 = CDbl(vValue2)
    
    Select Case sOperator
        Case "=": Compare = (vValue1 = vValue2)
        Case "<": Compare = (vValue1 < vValue2)
        Case "<=": Compare = (vValue1 <= vValue2)
        Case ">": Compare = (vValue1 > vValue2)
        Case ">=": Compare = (vValue1 >= vValue2)
        Case "<>": Compare = (vValue1 <> vValue2)
    End Select
End Function
Community
  • 1
  • 1
nikhil kumar
  • 45
  • 7
  • I feel that Dim objFormatCondition As FormatCondition is no longer a recognized dim. I am a noob, so please excuse if I have written something incorrectly. – nikhil kumar Sep 20 '20 at 07:01
  • Please use the "edit" button under the tags of your question to open the editor for your question. Details added in comments are often overlooked. – Tom Brunberg Sep 20 '20 at 07:21
  • Why do you think `Dim objFormatCondition As FormatCondition` is at fault? Do you get any error messages? – Tom Brunberg Sep 20 '20 at 07:21
  • "no longer works" does not provide any information on the problem you encounter. It should show: the code used, the type of error and the point where the error occurs. – Zer0Kelvin Sep 20 '20 at 07:28
  • @TomBrunberg, thanks for being responsive. I receive an error message at the line of code - [link]"Set objFormatCondition = rgeCell.FormatConditions(iconditionscount)" and hence I think so – nikhil kumar Sep 20 '20 at 07:29
  • I am sorry I just tried opening the editor but not sure how to use it. – nikhil kumar Sep 20 '20 at 07:30
  • In the editor there is a help button (as a question mark). – Tom Brunberg Sep 20 '20 at 07:34
  • Btw, from here we do not see your screen. You say *I receive an error message* without telling what exactly the message says. That is a very unhelpful, as I'm sure you understand. So please, be sure to include all relevant details in your questions. – Tom Brunberg Sep 20 '20 at 07:41
  • I am sorry, I figured out how to post questions. Sorry for troubling. The original post has been modified now – nikhil kumar Sep 20 '20 at 09:13
  • What value shows `iconditionscount` when the code stops on error? I mean, moving the cursor over it... – FaneDuru Sep 20 '20 at 09:34
  • It shows the value as 1. Since it showed the value, I thought that it might be some error with "objFormatCondition" – nikhil kumar Sep 20 '20 at 09:49
  • Does the code return this error for the first cell sent to the function? – FaneDuru Sep 20 '20 at 10:03
  • Yes it shows the error at the very first loop and does not allow the code to run further – nikhil kumar Sep 20 '20 at 10:05
  • I am not sure if the community allows, but if possible, I can share screen and share my personal ID to do so – nikhil kumar Sep 20 '20 at 10:05
  • BTW, I just tried it on an office 365 laptop as well and the code does not run there too – nikhil kumar Sep 20 '20 at 10:26
  • I do not think it is a matter of Excel version. Try the code, please on a different workbook. – FaneDuru Sep 20 '20 at 10:42
  • I just did on both the laptops. Created a dummy range with a b c d repeating multiple times and tried to run the code. It shows type mismatch at the exact same point on both versions of excel that I have. Does that work fine on your laptop? – nikhil kumar Sep 20 '20 at 10:52
  • I do not have Office 19 installed, but I cannot understand why such a simple line could rise an error... – FaneDuru Sep 20 '20 at 11:22
  • Even I don't understand. I creates problem on office 365 too (the other laptop that I have mentioned) – nikhil kumar Sep 20 '20 at 11:34
  • I think I understand a bit as to why this might not be performing well. Can someone suggest if that is right. I see case statements for calculations i.e. greater than/less than etc, I however do not see a statement for Duplicates. Can that be the reason why this is not performing. I shall try my luck on case statements and shall revert if this works for me. Additionally, if someone thinks that it is on account of that case statement for duplicates is missing, can someone hwlp me modify the code as I am sure if I do, I will definitely fall into a trap and will be on an endless loop of errors :p – nikhil kumar Sep 21 '20 at 05:29

2 Answers2

1

Please, try the next simpler approach. Select a conditional formatted cell and run the next code:

Sub testStaticCelFormatFromCondForm()
  With ActiveCell
    .Interior.Color = .DisplayFormat.Interior.Color
    .Font.Color = .DisplayFormat.Font.Color
    .Font.Bold = .DisplayFormat.Font.Bold
    .Font.Italic = .DisplayFormat.Font.Italic
    .Borders(xlEdgeLeft).Weight = .DisplayFormat.Borders(xlEdgeLeft).Weight
    .FormatConditions.Delete
  End With
End Sub

Or use it for all cells in a selected range:

Sub RangeStaticCelFormatFromCondForm()
Dim rng As Range, cel As Range
 Set rng = Selection
 For Each cel In rng
    With cel
      .Interior.Color = .DisplayFormat.Interior.Color
      .Font.Color = .DisplayFormat.Font.Color
      .Font.Bold = .DisplayFormat.Font.Bold
      .Font.Italic = .DisplayFormat.Font.Italic
      .Borders(xlEdgeLeft).Weight = .DisplayFormat.Borders(xlEdgeLeft).Weight
    End With
 Next
 rng.FormatConditions.Delete
End Sub

This last case works for individual cells conditions, but Conditional Formatting will be deleted at the end, for all the range, so nothing will be missed...

FaneDuru
  • 38,298
  • 4
  • 19
  • 27
  • thanks for the code, I had this code but wanted a modification of the earlier code as that code converts all conditionals to static and was a very useful code for me till now. Using the code that you provided, the only issues I will face is that I have a lot of conditionals set up in my file and it will skip the last conditionals of each type. Thanks a lot though for your effort and helping me out – nikhil kumar Sep 20 '20 at 09:16
  • @nikhil kumar: I maybe missed something from your question. I tried answering it based on its title. Don't you need **to transform in static all format properties like they are shown**, no matter of which condition made it like it is? What do you mean by "it will skip the last conditionals of each type? Why conditionals count and not only their result in terms of formatting? – FaneDuru Sep 20 '20 at 09:40
  • I meant, I tried using this code and let's assume that I have 20 different conditional formatting set up on a sheet. Taking the first one as an example - Let's assume I have the number 1 listed on a sheet 20 times and I ran a duplicate conditional formatting, what this macro does is that it converts the first 19 to static and leaves the last (20th) value as unhighlighted. I would want that to be highlighted in the same manner as the first one so that I know what all are duplicates . Please note that duplicates is just an example. I have the conditionals set up on a few check formulas – nikhil kumar Sep 20 '20 at 09:56
  • I am sure that it was me who was not able to explain it properly initially and hence I reposted the question. The question above has been modified with the code and the statement where I face the error along with the error that I get. Let me know if something is still not clear – nikhil kumar Sep 20 '20 at 10:03
  • 1
    @nikhil kumar: Try the updated code, please. It should work, since the Conditional Formatting is deleted at the end, for all the range cells, after their format has already been copied. Test it and send some feedback, please. – FaneDuru Sep 21 '20 at 12:45
0

thanks for help on the code.

Using the basic knowledge that I had and help from users like @faneduru, I have been able to tweak the code to be faster. Thanks you all for help. Let me know in case of any feedback

Please find the code as below -

Sub FreezeConditionalFormattingOnSelection()
Dim Rng As Range, cel As Range, rng2 As Range
 
 
On Error GoTo Step102
 
Step101:

Set Rng = Application.Selection
 Set Rng = Application.InputBox(Prompt:="Select range to check for conditional formatting", Title:="Select range", Default:=Rng.Address, Type:=8)
If Rng.Rows.Count < 2 Or Rng.Columns.Count < 2 Then
MsgBox "Please select a range containing more than 2 cells. Reselect range!!", vbCritical, "Range selection error"
GoTo Step101
End If

 
 
 Set rng2 = Rng.Cells.SpecialCells(xlCellTypeAllFormatConditions)
 
 For Each cel In rng2
    With cel
      .Interior.Color = .DisplayFormat.Interior.Color
      .Font.Color = .DisplayFormat.Font.Color
      .Font.Bold = .DisplayFormat.Font.Bold
      .Font.Italic = .DisplayFormat.Font.Italic
    End With
 Next
 Rng.FormatConditions.Delete

Exit Sub

Step102:

MsgBox "No conditional formatting cells found in selected range.", vbInformation, "No conditional formats found"

End Sub
nikhil kumar
  • 45
  • 7