Check a shifting range with numbers for duplicates and highlight?

[NessPJ]

Hi,

I am looking for a way to check for duplicates in a moving range and highlight them.

For example i have Columns K, L, M, N roughly 2000 lines filled with numbers and i want every Cell to check the surrounding 36 Cells for a duplicate and when there is, highlight it.

Is this possible?

 

[NessPJ]

Does this do what you want then?

24 12 10.xlsm
	K	L	M	N
1	Headers
2
3
4
5
6	32	17	93	39
7	62	73	38	67
8	56	43	28	73
9	57	63	58	62
10	96	33	55	48
11	52	6	84	92
12	66	67	20	51
13	95	46	76	83
14	49	25	33	68
15	64	86	67	45
16	33	46	24	64
17	88	31	86	76
18	85	97	37	53
19	29	20	86	95
20	39	9	22	47
21	22	85	70	7
22	95	97	51	19
23	30	15	62	26
24	88	41	61	67
25	48	63	31	37
26	90	86	99	26
27	96	62	21	27
28	89	55	5	35
29	32	70	19	91
30	25	65	88	85
31	45	67	14	28
32	92	38	95	96
33	98	58	45	33
34	98	7	29	31
35	98	90	49	96
36	52	84	33	76
37	28	39	81	64
38	2	27	98	74
39	49	69	74	10
40	8	24	7	54
41	89	93	62	75
42	58	30	22	2
43	68	26	3	7
44	24	21	37	62
45	28	23	47	76
46	60	77	97	34
47	53	42	4	35
48	23	7	10	24
49	32	15	93	40
50	96	73	87	67
51	24	76	85	24
52	43	81	73	10
53	36	79	78	61
54	90	39	29	4
55	20	59	55	77
56	3	82	46	50
57	58	32	7	36
58	35	65	44	28
59	96	16	21	10
60	52	85	34	21
61	8	33	1	51
62	90	57	44	75
63	54	50	82	80
64	88	42	53	36
65	62	78	38	68
66	58	19	6	86
67	95	12	68	68
68	69	38	57	41
69	8	99	61	34
70	8	27	28	91
71	64	16	44	58
72	93	70	86	30
73	65	58	25	21
74	68	94	61	18
75	4	85	96	13
76	82	37	93	61
77	25	49	32	44
78	82	67	19	91
79	45	98	27	6
80	56	83	28	83
81	62	52	42	94
82	93	26	17	42
83	6	47	65	67
84	60	47	29	47
85	34	34	61	37
86	86	57	5	78
87	68	87	37	86
88	96	16	37	10
89	25	59	92	75
90	80	2	49	32
91	90	23	87	25
92	26	77	70	95
93	54	90	54	65
94	26	2	6	63
95	29	85	45	75
96	63	51	64	78
97	56	33	93	13
98	2	32	45	17
99	55	26	49	59
100	32	26	48	49
101	65	79	65	44
102	63	95	47	7
103	43	17	98	12
104	3	61	16	5
105	86	86	32	24
106	60	18	59	95
107	5	6	10	50
108	44	26	80	18
109	9	35	69	45
110	86	85	37	79
111	55	60	98	65
112	50	96	94	79
113	65	16	7	77
114	8	44	34	2
115	49	8	6	58
116	36	16	10	91
117	44	37	77	56
118	62	72	96	89
119	23	38	60	1
120	52	31	94	51
121	90	24	70	44
122	36	28	8	46
123	62	27	99	81
124	55	18	22	65
125	92	22	15	84
126	90	91	57	69
127	69	64	75	75
128	34	77	30	52
129	86	52	37	52
130	2	92	36	50
131	84	6	1	58
132	24	96	77	82
133	42	89	72	86
134	8	60	62	6
135	94	87	12	79
136	5	12	26	37
137	83	40	22	90
138	59	74	29	52
139	28	50	75	12
140	58	30	34	63
141	62	90	95	16
142	98	87	39	62
143	26	73	94	19
144	62	62	95	12
145	8	67	28	74
146	86	47	97	91
147	34	45	57	54
148	88	23	48	90
149	68	89	85	13
150	69	83	17	23
151	25	19	90	85
152	28	75	90	24
153	36	69	96	62
154	92	40	26	15
155	59	82	67	73
156	49	33	83	84
157	38	33	19	9
158	49	8	21	98
159	54	43	27	87
160	62	54	92	43
161	6	5	47	27
162	6	98	30	76
163	80	58	59	39
164	88	94	33	14
165	85	82	12	36
166	8	51	85	2
167	55	76	24	82
168	88	16	79	63
169	62	28	86	77
170	34	10	87	80
171	9	79	55	81
172	24	67	59	6
173	95	79	73	84
174	82	43	96	77
175	94	21	52	53
176	52	43	93	57
177	85	99	33	82
178	26	54	46	96
179	65	38	55	13
180	95	8	90	97
181	59	37	3	12
182	34	6	17	56
183	66	46	87	34
184	45	83	50	44
185	55	72	45	28
186	69	98	38	60
187	40	26	57	6
188	58	2	60	62
189	90	87	17	67
190	90	95	4	23
191	49	78	19	93
192	3	12	35	85
193	2	46	60	99
194	66	39	73	38
195	23	13	7	68
196	85	49	8	54
197	24	20	99	69
198	54	90	24	1
199	22	25	93	39
200	22	17	7	15
201	90	99	89	36
202	25	82	83	81
203	94	2	85	65
204	56	65	21	46
205	94	33	95	85
206	52	23	77	79
207	48	29	38	96
208	49	5	97	47
209	56	32	84	65
210	53	91	80	8
211	82	15	38	94
212	20	49	48	24
213	94	32	45	73
214	45	67	68	3
215	62	48	84	29
216	8	7	28	27
217	23	92	82	9
218	80	2	8	37
219	96	4	63	47
220	46	95	34	53
221	58	76	41	20
222	53	21	24	82
223	42	8	14	18
224	39	89	44	7
225	34	63	67	23
226	89	45	33	70
227	23	69	14	78
228	45	17	64	68
229	43	78	1	92
230	22	29	43	24
231	23	41	31	29
232	8	75	84	47
233	28	76	59	22
234	64	85	47	77
235	96	18	35	9
236	28	26	45	83
237	46	93	68	48
NessPJ

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
K6:N237	Expression	=COUNTIF($K2:$N10,K6)>1	text	NO

This seems to work exactly. Can't believe the formula was that simple. Thanks a lot!

 

[NessPJ]

PS.
Now i created the following VBA code to accompany the conditional formatting as discussed here. But i keep getting an error when trying to write the Formula to the designated Cell.

Line:
TableCell.Formula = "=Text(RandBetweenInt(" & Lowest & "; " & Highest & "; " & Exclude & "); " & TextFormat & ")"
Keeps giving me an error (Object variable not set).
I expect the VBA to read the value from Cell Sheets("PARAMETERS").Range("M48").Value which actually contains a Range for the formula (value; PARAMETERS!$B$7:$B$10).
What am i doing wrong here?

Sub FindAndSolveDupes()

Dim CurSheet As String
Dim CurWb As Workbook
Dim DupeColor As String
Dim TableRange As Range, TableCell As Range
Dim Lowest As Long, Highest As Long, Exclude As Range, TextFormat As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

START:

DupeColor = Sheets("PARAMETERS").Range("M45").DisplayFormat.Interior.ColorIndex
'Default Orange color from Excel Colorindex = 44

Lowest = Sheets("PARAMETERS").Range("M46").Value
Highest = Sheets("PARAMETERS").Range("M47").Value
Exclude = Sheets("PARAMETERS").Range("M48").Value
TextFormat = Sheets("PARAMETERS").Range("M49").Value

Set TableRange = Selection
    For Each TableCell In TableRange
        If TableCell.DisplayFormat.Interior.ColorIndex = DupeColor Then
        TableCell.NumberFormat = "General"
        TableCell.Formula = "=Text(RandBetweenInt(" & Lowest & "; " & Highest & "; " & Exclude & "); " & TextFormat & ")"
        Application.Calculate
        TableCell.Formula = TableCell.Value
        End If

    Next TableCell
   
EINDE:

Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub

Function RandBetweenInt(Lowest As Long, Highest As Long, Exclude As Range) As Long

Dim R As Long
Dim C As Range
Do
R = Lowest + Int(Rnd() * (Highest + 1 - Lowest))
For Each C In Exclude
If R = C Then Exit For
Next C
Loop Until C Is Nothing

RandBetweenInt = R
Application.Volatile

End Function

 

[Peter_SSs]

When entering a formula with vba, use commas not semicolons, even if your Excel version normally uses semicolons for a worksheet formula separator.

If that does not resolve your problem please tell us what, exactly, is in each of these cells?

 

[NessPJ]

When entering a formula with vba, use commas not semicolons, even if your Excel version normally uses semicolons for a worksheet formula separator.

If that does not resolve your problem please tell us what, exactly, is in each of these cells?

View attachment 120261

Okay, so i tried updating the code with a Set as Range, but sadly that still did not work.
The values that are in those variables (and the Cells) are:

Lowest = 1
Highest = 99

ExcludeSheet = PARAMETERS
ExcludeAddress = $B$7:$B$10
Set Exclude = Sheets(ExcludeSheet).Range(ExcludeAddress)

TextFormat = 00

I still seem to be getting a "Type Mismatch" on "Exclude".

Sub FindAndSolveDupes()

Dim CurSheet As String
Dim CurWb As Workbook
Dim DupeColor As String
Dim TableRange As Range, TableCell As Range
Dim Lowest As Long, Highest As Long, ExcludeSheet As String, ExcludeAddress As String, Exclude As Range, TextFormat As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

START:

DupeColor = Sheets("PARAMETERS").Range("M45").DisplayFormat.Interior.ColorIndex
'Default Orange color from Excel Colorindex = 44

Lowest = Sheets("PARAMETERS").Range("M46").Value
Highest = Sheets("PARAMETERS").Range("M47").Value

ExcludeSheet = Sheets("PARAMETERS").Range("M48").Value
ExcludeAddress = Sheets("PARAMETERS").Range("M49").Value
Set Exclude = Sheets(ExcludeSheet).Range(ExcludeAddress)

TextFormat = Sheets("PARAMETERS").Range("M50").Value

Set TableRange = Selection
    For Each TableCell In TableRange
        If TableCell.DisplayFormat.Interior.ColorIndex = DupeColor Then
        TableCell.NumberFormat = "General"
        TableCell.Formula = "=Text(RandBetweenInt(" & Lowest & ", " & Highest & ", " & Exclude & "), " & TextFormat & ")"
        Application.Calculate
        TableCell.Formula = TableCell.Value
        End If

    Next TableCell
    
EINDE:

Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub

Function RandBetweenInt(Lowest As Long, Highest As Long, Exclude As Range) As Long

Dim R As Long
Dim C As Range
Do
R = Lowest + Int(Rnd() * (Highest + 1 - Lowest))
For Each C In Exclude
If R = C Then Exit For
Next C
Loop Until C Is Nothing

RandBetweenInt = R
Application.Volatile

End Function

 

[NessPJ]

This seems to have done the trick

Dim Lowest As Long, Highest As Long, ExcludeSheet As String, ExcludeAddress As String, Exclude As Range, TextFormat As String

ExcludeSheet = Sheets("PARAMETERS").Range("M48").Value
ExcludeAddress = Sheets("PARAMETERS").Range("M49").Value
Set Exclude = Sheets(ExcludeSheet).Range(ExcludeAddress)
ExcludeString = "'" & ExcludeSheet & "'!" & Exclude.Address


TableCell.Formula = "=Text(RandBetweenInt(" & Lowest & ", " & Highest & ", " & ExcludeString & "), " & TextFormat & ")"

 

[Peter_SSs]

Glad you seem to have resolved it. Thanks for letting us know.