An odd-ball One - Cell value range to code

[klarowe]

This one is kind of hard to explain, but I'm going to give it a shot.
Basically on this report I have been working on, a few sheets have some dimensional data. In one column there is an actual dimension and another has the drawing dimension (spec). SOmething like this:
___A________B_________C______________D_______
Actual:___ 1.1234"___ Drawing:___ 1.1000" - 1.2000"

What I want to do is set the "B1" cell interior color to be green if the actual dimension falls within the drawing spec, and red if it does not.
I know I can use a select case to get it to make the color, but what I can't figure out is how to use the entered data in D1 to change from ".1000" - .2000"" to .1000 to .2000 and then transfered into my macro as the case.
Hopfully that makes sense to someone... lol.

A couple notes. In almost all cases, how it is written in the example is exactly how it will be... with the exception of possibly only 3 decimal places instead of 4. But the " will almost always be there, and so will the - . And if it cannot be done without changing the format then I will have to skip on this one b/c it is more important to have the units in the cell than to have the background color.

 

[klarowe]

Well this might be a longer way, but I got everything to work this way:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Rng As Range, Dn As Range
    Dim temp As Double
    Dim Dmin
    Dim DMax
    Set Rng = Range(Range("C5"), Range("C6"))
    For Each Dn In Rng
        temp = Replace(Dn, """", "")
        Dmin = Val(Trim(Replace(Split(Dn.Offset(, 2), "-")(0), """", "")))
        DMax = Val(Trim(Replace(Split(Dn.Offset(, 2), "-")(1), """", "")))
        Dn.Interior.ColorIndex = IIf(temp >= Dmin And temp <= DMax, 4, 3)
    Next Dn
    Set Rng = Range(Range("C12"), Range("C13"))
    For Each Dn In Rng
        temp = Replace(Dn, """", "")
        Dmin = Val(Trim(Replace(Split(Dn.Offset(, 2), "-")(0), """", "")))
        DMax = Val(Trim(Replace(Split(Dn.Offset(, 2), "-")(1), """", "")))
        Dn.Interior.ColorIndex = IIf(temp >= Dmin And temp <= DMax, 4, 3)
    Next Dn
End Sub

Thanks for the help!!!!

 

[MickG]

"Target.Column = 2" = Column "B"
You can alter the column number but, if your Toleranced Dimension
shown at the moment as column "D" is always 2 columns away from the target column, it will still work, but if not you will need to alter the lines
"Dmin = Val(Trim(Replace(Split(Target.Offset(, 2), "-")(0), """", "")))"
and
"DMax = Val(Trim(Replace(Split(Target.Offset(, 2), "-")(1), """", ""))) "to take acount of any new column offset (shown at the moment as 2).

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim temp As Double
Dim Dmin
Dim DMax
If Target.Count = 1 Then
If Target <> "" And Target.Column = 2  Then 'Column "B" Here !!
  temp = Replace(Target, """", "")
    If IsNumeric(temp) Then
      Dmin = Val(Trim(Replace(Split(Target.Offset(, 2), "-")(0), """", "")))
        DMax = Val(Trim(Replace(Split(Target.Offset(, 2), "-")(1), """", "")))
           Target.Interior.ColorIndex = IIf(temp >= Dmin And temp <= DMax, 4, 3)
    End If
End If
End if 
End Sub

Regards Mick

 

[klarowe]

Almost there... lol. Is there anyway to modify that code you just posted to update no matter where I click? I like that one better because it works for pretty much all the sheets (just need to change the column rather than enter in each exact range) but in order to get the color background to appear I have to click back onto that cell again rather than entering the information, clicking the next cell, and having that last one automatically colored.

Thanks again in advance!

The other code you posted first worked perfectly other than letting me enter in more than just the 2 ranges. If I could get that to allow me to enter in all the ranges in one location it would be perfect. (or modify this latest code to automatically change when any cell is clicked which I don't think can be done because we are specifying the target...)

 

[MickG]

If you have something like a Header in row (1), saying "Dimension" or some other way of Defining the column with the Dimensions to be checked.
Then you could perhaps , just double click "A1" or similar, and the code would automatically find the correct column to check and colour.the cells accordingly.
Mick

 

[klarowe]

Unfortunately not. Its not a big deal though. Its a little longer code, but this is working perfectly:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Rng As Range, Dn As Range
    Dim temp As Double
    Dim Dmin
    Dim DMax
    Set Rng = Range("C9")
    For Each Dn In Rng
        If Rng.Value <> "" Then
            temp = Replace(Dn, """", "")
            Dmin = Val(Trim(Replace(Split(Dn.Offset(, 2), "-")(0), """", "")))
            DMax = Val(Trim(Replace(Split(Dn.Offset(, 2), "-")(1), """", "")))
            Dn.Interior.ColorIndex = IIf(temp >= Dmin And temp <= DMax, 4, 3)
        Else: Dn.Interior.ColorIndex = 0
        End If
    Next Dn
 
    Set Rng = Range("C10")
    For Each Dn In Rng
        If Rng.Value <> "" Then
            temp = Replace(Dn, """", "")
            Dmin = Val(Trim(Replace(Split(Dn.Offset(, 2), "-")(0), """", "")))
            DMax = Val(Trim(Replace(Split(Dn.Offset(, 2), "-")(1), """", "")))
            Dn.Interior.ColorIndex = IIf(temp >= Dmin And temp <= DMax, 4, 3)
        Else: Dn.Interior.ColorIndex = 0
        End If
    Next Dn
 
    Set Rng = Range("C11")
    For Each Dn In Rng
        If Rng.Value <> "" Then
            temp = Replace(Dn, """", "")
            Dmin = Val(Trim(Replace(Split(Dn.Offset(, 2), "-")(0), """", "")))
            DMax = Val(Trim(Replace(Split(Dn.Offset(, 2), "-")(1), """", "")))
            Dn.Interior.ColorIndex = IIf(temp >= Dmin And temp <= DMax, 4, 3)
        Else: Dn.Interior.ColorIndex = 0
        End If
    Next Dn
End Sub

I just have to go in and change the range and add/remove each section as needed for each sheet. Not a big deal though. There really are only going to be a max of 4 different ranges on each sheet and some will be the same so I can just copy/paste/edit as needed.

Thanks again for the help.

 

[klarowe]

Ok, I lied. There is one issue left. On a VERY rare occasion, one of our techs will put a "range" into the "actual" cell (ie 1.2345"-1.2346") is there a way to either;
a) read the value as a range and if both numbers are within spec then its green, and if either number is out of spec it is red, or
b) Create an "On Error" that will go to the next dn. If I just do "on error resume next" it automatically puts the box to red... skipping it is fine, but I would rather keep the box as no fill.
Thanks again!!!

 

[klarowe]

Edit: Nvmd I thought I had it working...

 

[MickG]

Here's the first code modified tio accept both single and duel dimensions in col "B".

[COLOR="Navy"]Sub[/COLOR] MG11May53
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] temp [COLOR="Navy"]As[/COLOR] Double
[COLOR="Navy"]Dim[/COLOR] Temp1 [COLOR="Navy"]As[/COLOR] Double
[COLOR="Navy"]Dim[/COLOR] temp2 [COLOR="Navy"]As[/COLOR] Double
[COLOR="Navy"]Dim[/COLOR] Dmin
[COLOR="Navy"]Dim[/COLOR] DMax
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Dmin = Val(Trim(Replace(Split(Dn.Offset(, 2), "-")(0), """", "")))
    DMax = Val(Trim(Replace(Split(Dn.Offset(, 2), "-")(1), """", "")))
    [COLOR="Navy"]If[/COLOR] InStr(Dn, "-") [COLOR="Navy"]Then[/COLOR]
        Temp1 = Val(Trim(Replace(Split(Dn, "-")(0), """", "")))
        temp2 = Val(Trim(Replace(Split(Dn, "-")(1), """", "")))
        Dn.Interior.ColorIndex = IIf(Temp1 >= Dmin And Temp1 <= DMax And temp2 >= Dmin And temp2 <= DMax, 4, 3)
    [COLOR="Navy"]Else[/COLOR]
        temp = Replace(Dn, """", "")
        Dn.Interior.ColorIndex = IIf(temp >= Dmin And temp <= DMax, 4, 3)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[klarowe]

Perfect. Thanks!!!