Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
any ideas?
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 :-) |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
any ideas?
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 :-) |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
any ideas?
Before the code, here are the general steps:
1. split the list into separate cells in a helper column 2. sort the helper column 3. calculate the difference between adjoining cells 4. look for the minimum difference 5. color by numbers Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Range("A1"), Target) Is Nothing Then Exit Sub End If n = Split(Target.Value, ",") Application.EnableEvents = False Set r = Range("Z1") r.EntireColumn.Clear r.Offset(0, 1).EntireColumn.Clear i = 1 For j = LBound(n) To UBound(n) r.Offset(i, 0).Value = n(j) i = i + 1 Next Range("Z2:Z65536").Sort Key1:=Range("Z2") For j = 2 To Rows.Count If IsEmpty(r.Offset(j, 0)) Then Exit For End If r.Offset(j, 1).Value = r.Offset(j, 0).Value - r.Offset(j - 1, 0).Value Next Set rr = Range("AA:AA") j = Application.WorksheetFunction.Min(rr) r.Value = j Application.EnableEvents = True End Sub This uses columns Z and AA as helper column aand assumes the string of values is in cell A1. The items are placed in Z2 on down The differences are in AA3 on down The minimum difference is placed in Z1 Set the conditional formatting of A1 to: Formula Is =Z1<3 and format as you like. Put the code in the Worksheet code area, not a standard module. -- Gary''s Student - gsnu200721 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
any ideas?
Slightly more efficient plus it will handle a passed column as well:
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) If UB = 1 Then '1 column wide range was passed UB = UBound(arr) For i = 1 To UB For n = i + 1 To UB If Abs(arr(i, 1) - arr(n, 1)) < lMinValue Then ValuesTooClose = True Exit Function End If Next n Next i Else '1 row high range was passed For i = 1 To UB For n = i + 1 To UB If Abs(arr(1, i) - arr(1, n)) < lMinValue Then ValuesTooClose = True Exit Function End If Next n Next i End If 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 :-) |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 :-) |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
any ideas?
Hello,
A suggestion without VBA: 1. Define name a: =A1:E1 (your input area) 2. Enter into F1 (the first adjacent cell to the right from a): =2*MAX(A1:E1)-MIN(A1:E1) 3. Select A1:E1 and enter conditional format (formula): =MIN(LARGE(OFFSET(a,0,1);ROW(INDIRECT("1:"&COUNTA( a))))- LARGE(a,ROW(INDIRECT("1:"&COUNTA(a))))) with a convenient format. Regards, Bernd |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
any ideas?
Dear RB, Thank you for your help. Unfortunately it now appears I am getting ahead of myself and this function is beyond my Excel skills- I need to go on a course! I have no experience with VBA, so am unclear what exactly I need to do with the code you sent me. I have been fiddling around and reading my Excel book but am still confused. Could you let me know what I need to do from start to finish? Can we say my values are contained in the range A3:G3 and i am working on sheet 1? Thank you- I understand if you don't reply as I am a pain the the bum! Lookign at VBA has got me really interested though and I am eager to learn more! "RB Smissaert" wrote: 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 :-) |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
any ideas?
No trouble.
You can use the function (ValuesTooClose2) from VBA or as a worksheet function. I presume you want the second, so I will explain that. In the workbook you are working with you will need a normal code module to put the 2 functions in. This is how you do that: In Excel press Alt + F11. This will get you in the VBE (VB editor). Then you press Ctrl + R. This will bring up the project explorer on the left-hand side. In this project explorer find the project that belongs to the current workbook, say VBAProject(Book1). Right-click that project and do Insert Module. This module will now show on the right-hand side. Copy the 2 functions I posted and paste them in that right-hand code pane. Now you are set to use the function ValuesTooClose2 in the sheet, so go back to the sheet by pressing Alt + F11 again. Say you have your values to test in the range A3: G3. Now select cell H3 (any cell will do) and do: Insert (at the top toolbar), Function, from the category box pick User defined and click on your newly added UDF ValuesTooClose2. You now get a dialog where you will have to input the range and the minimum value. Click in the range box (the top one in that dialog) and then select the required range in the sheet, so in this case A3:G3. Then click in the next box and put in the minimum value, say 3. Then press OK and you are done. The function will produce True or False, depending on whether any of the values in the range are too close together. Try changing some values in the range and you will see that it works. If you are interested in VBA then best to buy a beginners book and you will be on your way. RBS "rosysnozzy" wrote in message ... Dear RB, Thank you for your help. Unfortunately it now appears I am getting ahead of myself and this function is beyond my Excel skills- I need to go on a course! I have no experience with VBA, so am unclear what exactly I need to do with the code you sent me. I have been fiddling around and reading my Excel book but am still confused. Could you let me know what I need to do from start to finish? Can we say my values are contained in the range A3:G3 and i am working on sheet 1? Thank you- I understand if you don't reply as I am a pain the the bum! Lookign at VBA has got me really interested though and I am eager to learn more! "RB Smissaert" wrote: 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 :-) |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Any ideas on how to do this? | Excel Programming | |||
Any Ideas? | Excel Worksheet Functions | |||
Ant ideas? | Excel Programming | |||
Any ideas? | Excel Programming | |||
Any ideas? | Excel Programming |