Reputation: 93
Select Case with OR
I'm trying to set up a conditional formatting where if the value in my cell doe not equal to item1 or item2 or item3 and so on then it would highlight it. The code is highlighting my cell even though the value is equal to one of the items. So pretty much I have a list of items that could be chosen but if the value does not equal one of the items in the list then it would highlight it. Here is my current code:
Dim item1 As Double, item2 As Double
Dim item3 As Double, item4 As Double
Dim item5 As Double, item6 As Double
Dim item7 As Double, item8 As Double
Dim item9 As Double, item10 As Double
Dim item11 As Double, item12 As Double
Dim material As Range
Dim C As Range
item1 = Me.Range("l5")
item2 = Me.Range("m5")
item3 = Me.Range("n5")
item4 = Me.Range("o5")
item5 = Me.Range("p5")
item6 = Me.Range("q5")
item7 = Me.Range("r5")
item8 = Me.Range("l7")
item9 = Me.Range("m7")
item10 = Me.Range("n7")
item11 = Me.Range("o7")
item12 = Me.Range("p7")
Set material = Intersect(Target, Me.Range("d24:d109"))
Application.EnableEvents = False
If Not material Is Nothing Then
For Each C In material.Cells
v = C.Value
If Len(v) > 0 Then
Select Case v
Case Is <> item1 Or item2 Or item3 Or item4 Or item5 Or item6 Or item7 Or item8 Or item9 Or item10 Or item11 Or item12: newcolor = 3
End Select
Else
newcolor = xlNone
End If
C.Interior.ColorIndex = newcolor
Next C
End If
Application.EnableEvents = True
Upvotes: 0
Views: 2089
Answers (3)
Reputation: 2392
I think I finally tracked down the issue. Worth noting, before I explain, that you will want to try stepping through your code in the future. Breakpoints, 'Debug.Print' and F8 make a tremendous difference.
In this case, your roll ID's are different from your input values. Your roll Id in L7 is 70030908 note the whitespaces on either side. If I do 'Debug.Print ws.Range("L7").Value = 70030908` I get False. This is because, while the two look mostly like the same number, they aren't the same. Again, note the whitespaces on either side of the first number. To solve this, use explicit type conversion:
Dim TargetRange As Range
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Componentlog")
Set TargetRange = Intersect(Target, ws.Range("D24:D" & ws.Rows.Count))
Application.EnableEvents = False
Dim cell As Range
Dim NewColor As Variant
If Not TargetRange Is Nothing Then
For Each cell In TargetRange.Cells
If Len(cell.Value) > 0 and IsNumeric(cell.Value) Then
Select Case CDbl(cell.Value)
Case CDbl(ws.Range("L5").Value)
Case CDbl(ws.Range("M5").Value)
Case CDbl(ws.Range("N5").Value)
Case CDbl(ws.Range("O5").Value)
Case CDbl(ws.Range("P5").Value)
Case CDbl(ws.Range("Q5").Value)
Case CDbl(ws.Range("R5").Value)
Case CDbl(ws.Range("L7").Value)
Case CDbl(ws.Range("M7").Value)
Case CDbl(ws.Range("N7").Value)
Case CDbl(ws.Range("O7").Value)
Case CDbl(ws.Range("P7").Value)
Case Else
NewColor = 3
End Select
Else
NewColor = xlNone
End If
cell.Interior.ColorIndex = NewColor
NewColor = xlNone
Next cell
End If
Application.EnableEvents = True
This way, we force the input value to be a Double and we force the checked value to be a Double. The CDBL will happily take a string like "1234" and will convert it to 1234. In the case of your needs, it will ensure both the input value, and the checked value are able to match.
The macro then runs just fine.
Upvotes: 0
Reputation: 2392
Try something like this. The method is still somewhat inffective (since you are looping through cells), but it should work for your needs.
The methodology behind this is simple, if the cell value matches one of the existing criteria then do nothing. If it doesn't match any of them it will default to Case Else where it will set NewColor to 3.
The other thing worth noting is NewColor was never being reset to xlNone in your original version. This could cause the issue (since it was only being returned to xlNone when the len of the cell was 0.
Finally, I cleaned up code names and structure a bit. Try to make variable names more descriptive, and fully qualify everything (don't rely on Double foo = bar.Range("baz") since this will inevitably trip you up).
Sub Reformat()
Dim TargetRange As Range
Set TargetRange = Intersect(Target, Me.Range("d24:d109"))
Application.EnableEvents = False
Dim cell As Range
Dim NewColor As Variant
If Not material Is Nothing Then
For Each cell In material.Cells
If Len(cell.value) > 0 Then
Select Case cell.value
Case Is = Me.Range("L5").value
Case Is = Me.Range("M5").value
Case Is = Me.Range("N5").value
Case Is = Me.Range("O5").value
Case Is = Me.Range("P5").value
Case Is = Me.Range("Q5").value
Case Is = Me.Range("R5").value
Case Is = Me.Range("L7").value
Case Is = Me.Range("M7").value
Case Is = Me.Range("N7").value
Case Is = Me.Range("O7").value
Case Is = Me.Range("P7").value
Case Else
NewColor = 3
End Select
Else
NewColor = xlNone
End If
cell.Interior.ColorIndex = NewColor
NewColor = xlNone
Next cell
End If
Application.EnableEvents = True
End Sub
Upvotes: 1
Reputation: 53623
Comma separated:
Case Is <> item1, item2, item3, item4, item5, item6, item7, item8, _
item9, item10, item11, item12
But it's probably better to use a different data structure so that you don't need to keep adding item variables:
Dim coll as New Collection
coll.Add Me.Range("l5").Value2
coll.Add Me.Range("m5").Value2
coll.Add Me.Range("n5").Value2
coll.Add Me.Range("o5").Value2
coll.Add Me.Range("p5").Value2
coll.Add Me.Range("q5").Value2
coll.Add Me.Range("r5").Value2
coll.Add Me.Range("l7").Value2
coll.Add Me.Range("m7").Value2
coll.Add Me.Range("n7").Value2
coll.Add Me.Range("o7").Value2
coll.Add Me.Range("p7").Value2
And then use a function like described here to test whether the value exists in the collection.
If Len(v) > 0 Then
If Not colItmExists(coll, v) Then
'Do something, or not...
End If
Function:
Function colItmExists(col As Collection, itm) As Boolean
Dim i, ret As Boolean
For i = 1 To col.Count
If col(i) = itm Then
ret = True
Exit For
End If
Next
colItmExists = ret
End Function
Upvotes: 1