Change the color of a cell when it differs from a default value

[UncleBajubjubs]

Hello, I have a program used to estimate the cost of and then design large machinery. First, an estimator will enter the specifics needed for the machinery and select all the parts for its construction (motors, steel, etc.). This is all tallied up on a worksheet, "Selected Parts", and a cost is calculated so the customer can know if they want to buy it. If the customer accepts the price, then the engineers take over. They'll go through and check each piece to make sure that the machine will function, and if not, they will change out the piece for another piece that will work.

I'd like to add some formatting to highlight the cells in which the engineers change the part from the estimated value. For instance, if the estimator calls for a "50 horsepower motor" and then engineer changes it to a "60 horsepower motor", that cell is now highlighted in yellow.

I was initially looking at having a macro to copy the estimated values onto another worksheet, "Selected Parts Copy", and use conditional formatting to highlight the cells on "Selected Parts" whenever they differ from "Selected Parts Copy". However, the most complicated machines can have several hundred parts, and I'm hoping to find an easier way to do this so I do not have to manually set up conditional formatting on these hundreds of cells. Any ideas?

Thanks!

 

[UncleBajubjubs]

We have rules against sharing our programs (if a competitor sees how we calculate prices, they can undercut, etc.) so I cannot post it. If I can say, for instance, the value of cell D11 = =Inputs!AO34, would that be enough to set it up for that cell specifically, and then I can extend the code to the rest of the cells.

 

[UncleBajubjubs]

I'm thinking I'd use the Worksheet_calculate and have a loop run for each cell in a range (the range being all the cells I want it to check). But you may have a better idea. (Too late to edit my previous post to add this)

 

[mumps]

Give this a try in the worksheet code module:

Private Sub Worksheet_Calculate()
    Application.ScreenUpdating = False
    Dim rng As Range
    For Each rng In ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas)
        If rng.Value <> Sheets("Selected Parts Copy").Range(rng.Address).Value Then
            MsgBox ("Cell " & Target.Address(0, 0) & " has been changed.")
            Target.Interior.ColorIndex = 3
        Else
            Target.Interior.ColorIndex = xlNone
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[UncleBajubjubs]

I'm getting the "object required" error on the Target.Interior.ColorIndex = xlNone and Target.Interior.ColorIndex = 3 lines.

 

[mumps]

Oops! Change "Target" to "rng".

 

[UncleBajubjubs]

Oops! Change "Target" to "rng".

Thanks again, the line



If rng.Value <> Sheets("Selected Parts Copy").Range(rng.Address).Value Then

now however gives type mismatch. I put in a messagebox to test, it went through tons of cells before the error.

 

[mumps]

The only way I could get this to work is by doing the following:
-The formulas such as =Inputs!AO34 must be in "Selected Parts Copy"
-No formulas in "Selected Parts" are needed
-When you make a change in "Inputs", the values with the formula in "Selected Parts Copy" will change accordingly.
-The following macro will go in the worksheet code module for "Inputs". Notice that it is no longer a Worksheet_Calculate event.

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    Dim rng As Range
    For Each rng In Sheets("Selected Parts Copy").Cells.SpecialCells(xlCellTypeFormulas)
        If rng.Value <> Sheets("Selected Parts").Range(rng.Address).Value Then
            MsgBox ("Cell " & rng.Address(0, 0) & " has been changed.")
            Sheets("Selected Parts").Range(rng.Address).Interior.ColorIndex = 3
        Else
            Sheets("Selected Parts").Range(rng.Address).Interior.ColorIndex = xlNone
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

When you change a value in "Inputs" the value in "Selected Parts Copy" will change. The macro will compare the cells with formulas in "Selected Parts Copy" with the corresponding cell in "Selected Parts" and highlight the cell if different. This worked for me using dummy data and formulas. However, since I can't see your workbook, I'm not sure how this would work with your actual data.

 

[UncleBajubjubs]

I haven't been able to get back to this until now, so thank you for this method. Unfortunately I've found that the number of cells with formulas is great enough that a noticeable lag occurs when you mess with the specified cells (thus running the macro), so I'm thinking it'd be easier to simply have a button to press when they wish to check what they've changed, so it'll only slow down the program then. This button would be on the "Selected Parts" Page. I also tried to modify it slightly as they may wish to directly overwrite a formula rather than accept the computed value. For example, if a formula gives a value of 30 HP, but then engineering thinks 40 HP would be better, he will just directly type 40 into the cell. So selecting the cells which have formulas will not work in this instance. I tried to use UsedRange as the new area to check, but I believe I made an error in my syntax.

<code>


Sub CompareDifferences()


Application.ScreenUpdating = False
MsgBox "1"
Dim rng As Range
For Each rng In ActiveSheet.UsedRange

If rng.Value <> Sheets("Selected Parts Copy").Range(rng.Address).Value Then


rng.Interior.ColorIndex = 3
Else
rng.Interior.ColorIndex = xlNone
End If
Next rng
Application.ScreenUpdating = True
End Sub
</code>

I'm assuming I have to change the UsedRange line, but I'm not sure what needs to be done. Any ideas? Thanks.

 

[mumps]

Try:

Sub CompareDifferences()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Selected Parts").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim lCol As Long
    lCol = Sheets("Selected Parts").UsedRange.Columns.Count
    MsgBox "1"
    Dim rng As Range
    For Each rng In Sheets("Selected Parts").Range(Sheets("Selected Parts").Cells(2, 1), Sheets("Selected Parts").Cells(LastRow, lCol))
        If rng.Value <> Sheets("Selected Parts Copy").Range(rng.Address).Value Then
            rng.Interior.ColorIndex = 3
        Else
            rng.Interior.ColorIndex = xlNone
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[UncleBajubjubs]

This line
<code>
If rng.Value <> Sheets("Selected Parts Copy").Range(rng.Address).Value Then
</code>

seems to give "Type Mismatch" error. Also the random message box came from me tinkering around with it, I meant to remove it but forgot. Thanks