any ideas?
But if you are running this on a large range than the posted UDF is too slow
and you need to do it differently:
Function ValuesTooClose2(rng As Range, lMinValue As Long) As Boolean
'this is much faster if testing a large range
'--------------------------------------------
Dim i As Long
Dim n As Long
Dim UB As Long
Dim arr
arr = rng
UB = UBound(arr, 2)
If UB = 1 Then
'1 column wide range was passed
UB = UBound(arr)
QuickSortarrLongs1Col arr
For i = 2 To UB
If Abs(arr(i, 1) - arr(i - 1, 1)) < lMinValue Then
ValuesTooClose2 = True
Exit Function
End If
Next i
Else
'1 row high range was passed
QuickSortarrLongs1Row arr
For i = 2 To UB
If Abs(arr(1, i) - arr(1, i - 1)) < lMinValue Then
ValuesTooClose2 = True
Exit Function
End If
Next i
End If
End Function
Function QuickSortarrLongs1Col(arrLongs As Variant, _
Optional sOrder As String = "A", _
Optional lFirst As Long = -1, _
Optional lLast As Long = -1) As Variant
'for 2-D 1 column array
'----------------------
Dim lLow As Long
Dim lHigh As Long
Dim lMiddle As Long
Dim lTempVal As Long
Dim lTestVal As Long
If lFirst = -1 Then lFirst = LBound(arrLongs)
If lLast = -1 Then lLast = UBound(arrLongs)
lMiddle = (lFirst + lLast) / 2
lTestVal = arrLongs(lMiddle, 1)
lLow = lFirst
lHigh = lLast
Do
If sOrder = "A" Then
Do While arrLongs(lLow, 1) < lTestVal
lLow = lLow + 1
Loop
Do While arrLongs(lHigh, 1) lTestVal
lHigh = lHigh - 1
Loop
Else
Do While arrLongs(lLow, 1) lTestVal
lLow = lLow + 1
Loop
Do While arrLongs(lHigh, 1) < lTestVal
lHigh = lHigh - 1
Loop
End If
If (lLow <= lHigh) Then
lTempVal = arrLongs(lLow, 1)
arrLongs(lLow, 1) = arrLongs(lHigh, 1)
arrLongs(lHigh, 1) = lTempVal
lLow = lLow + 1
lHigh = lHigh - 1
End If
Loop While (lLow <= lHigh)
If lFirst < lHigh Then QuickSortarrLongs1Col arrLongs, sOrder, lFirst,
lHigh
If lLow < lLast Then QuickSortarrLongs1Col arrLongs, sOrder, lLow, lLast
End Function
Function QuickSortarrLongs1Row(arrLongs As Variant, _
Optional sOrder As String = "A", _
Optional lFirst As Long = -1, _
Optional lLast As Long = -1) As Variant
'for 2-D 1 row array
'-------------------
Dim lLow As Long
Dim lHigh As Long
Dim lMiddle As Long
Dim lTempVal As Long
Dim lTestVal As Long
If lFirst = -1 Then lFirst = LBound(arrLongs)
If lLast = -1 Then lLast = UBound(arrLongs, 2)
lMiddle = (lFirst + lLast) / 2
lTestVal = arrLongs(1, lMiddle)
lLow = lFirst
lHigh = lLast
Do
If sOrder = "A" Then
Do While arrLongs(1, lLow) < lTestVal
lLow = lLow + 1
Loop
Do While arrLongs(1, lHigh) lTestVal
lHigh = lHigh - 1
Loop
Else
Do While arrLongs(1, lLow) lTestVal
lLow = lLow + 1
Loop
Do While arrLongs(1, lHigh) < lTestVal
lHigh = lHigh - 1
Loop
End If
If (lLow <= lHigh) Then
lTempVal = arrLongs(1, lLow)
arrLongs(1, lLow) = arrLongs(1, lHigh)
arrLongs(1, lHigh) = lTempVal
lLow = lLow + 1
lHigh = lHigh - 1
End If
Loop While (lLow <= lHigh)
If lFirst < lHigh Then QuickSortarrLongs1Row arrLongs, sOrder, lFirst,
lHigh
If lLow < lLast Then QuickSortarrLongs1Row arrLongs, sOrder, lLow, lLast
End Function
RBS
"RB Smissaert" wrote in message
...
There might be an Excel worksheet function, but this UDF will do it:
Function ValuesTooClose(rng As Range, lMinValue As Long) As Boolean
Dim i As Long
Dim n As Long
Dim UB As Long
Dim arr
arr = rng
UB = UBound(arr, 2)
For i = 1 To UB
For n = i To UB
If Abs(arr(1, i) - arr(1, n)) < lMinValue And i < n Then
ValuesTooClose = True
Exit Function
End If
Next n
Next i
End Function
Then do in the sheet: Insert, Function, User Defined etc.
RBS
"rosysnozzy" wrote in message
...
Hello clever Excel people,
I have tried various different formulas with no success. Basically I have
a
row of values, lets say: 10,45,12,28,30. I need formula that I can enter
into
conditional formatting so that if any of the values are less than 3 away
from
any of the other values (eg: 10 and 12 are too close, as are 28 and 30),
it
will turn a different colour to highlight the error. Please help, I have
exhausted all the Excel geeks at work including the IT department.
Thank you :-)
|