Add an Application InputBox into code

[julhs]

I need, what I hope is some quick help!!??

I have the code below that does what I want; it Coverts the EFFECT of the Condition Formatting rule to a FIXED interior colour matching the CF effect, it then deletes the rule.
What I want to do is incorporate a pop up Inputbox into the existing code to select the range to covert, rather than have to preselect the range before I run the sub.

Sub FixColor()
Dim r
For Each r In Selection
r.Interior.Color = r.DisplayFormat.Interior.Color
Next r
Selection.FormatConditions.Delete

End Sub

 

[DanteAmor]

Try this:

Sub FixColor()
  Dim rng As Range, r As Range
  
  On Error Resume Next
    Set rng = Application.InputBox("Select Range", Default:=Selection.Address, Type:=8)
    If rng Is Nothing Then Exit Sub
  On Error GoTo 0

  For Each r In rng
    r.Interior.Color = r.DisplayFormat.Interior.Color
  Next r
  rng.FormatConditions.Delete
End Sub

 

[julhs]

Thank you Dante.

At first glance this is what I was after.
But I’m not in a position to fully test it right now.
Will let you know later re; testing the out come.
Many thanks

 

[julhs]

MADE time to test it!
It is EXACTLY what I was after.

Thank you again.

 

[julhs]

I am going to have to come back to you with a further dimension on this.

Will get back to you asap

 

[julhs]

This “Further dimension” is going to seem a bit illogical, bearing in mind what the code has just done (fix the cell colour to the CF colour then delete the CF)
But note:- At the moment this is all about testing things for use in a larger Sub later; in the larger Sub I will need to REINSTATE the CF in the range where it was deleted.

I’ve spent the day expanding on your code to do what I wanted and come up with this:
It is doing what I want, but is there a more efficient/direct way to do this??
Code here:

Sub FixColorANDReinstateCF()
   Dim rng As Range, r As Range
   Dim copyCells As Range, pasteRng As Range
                xTitleId = "Fix cell color to CF color then Delete rule"
                xTitleId2 = "Copy and Paste Conditional Formatting"
On Error Resume Next
         Set rng = Application.InputBox("Select Range to Fix:", xTitleId, Default:=Selection.Address, Type:=8) 'To select range to fix
         Set copyCells = Application.Selection
         Set copyCells = Application.InputBox("Copy Condition Formatt from Cell:", xTitleId2, Default:=Selection.Address, Type:=8) 'To Select cell with CF to copy
                                     'Set pasteRng = Application.InputBox("Paste Condition Formatt to Range:", xTitleId2, Default:=Selection.Address, Type:=8) 'this NOW redundant as
                                     'now using InputBox("Select Range to Fix) range to be the range to paste to
                         Set pasteRng = rng
                     If copyCells Is Nothing Then Exit Sub
                     If rng Is Nothing Then Exit Sub
                             On Error GoTo 0
                For Each r In rng
                                   ' If there is one key line in all the code it is the next one
                                    ' as it converts the Conditional Formatting effect to a "Fixed" static color formatt
           r.Interior.Color = r.DisplayFormat.Interior.Color
     Next r
            rng.FormatConditions.Delete 'This deletes the CF rule from the range just coverted to "Fixed" colors 
        copypyCells.Copy
                  pasteRng.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                             SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
  End Sub