Add an Application InputBox into code

julhs

Active Member
Joined
Dec 3, 2018
Messages
471
Office Version
  1. 2010
Platform
  1. Windows
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.
VBA Code:
Sub FixColor()
Dim r
For Each r In Selection
r.Interior.Color = r.DisplayFormat.Interior.Color
Next r
Selection.FormatConditions.Delete

End Sub
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Try this:

VBA Code:
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
 
Upvote 0
Solution
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
 
Upvote 0
I am going to have to come back to you with a further dimension on this.

Will get back to you asap
 
Upvote 0
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:
VBA Code:
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
 
Upvote 0

Forum statistics

Threads
1,223,098
Messages
6,170,106
Members
452,302
Latest member
TaMere

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top