Macros to highlight three or more consecutive numbers entered in a set row

[anuptv]

Guys, I would like help in creating an macros to highlight duplicate values by searching in Rows and column in an excel sheet..

the criteria is three consecutive numbers or more...

for example:



20
157
650
43
265
856
48
417
544
250
11
778


56
13
66
139
246
396
697
667
197
127
506
106


231
522
8
87
724
522
210
409
301
968
57
103


928
38
259
182
31
20
157
650
43
583
101
446



the macros must search the excel sheet ( ex B2 to M32) and highlight the underlined letters..

[mana]

You can use "conditional formatting"


Option Explicit

Sub test()
Dim tbl As Range
Dim r(1 To 6) As Range
Dim f(1 To 6) As String
Dim k As Long
Dim fc As FormatCondition

Set tbl = Range("B2:M32")

Set r(1) = tbl.Resize(, tbl.Columns.Count - 2)
Set r(2) = r(1).Offset(, 1)
Set r(3) = r(1).Offset(, 2)

Set r(4) = tbl.Resize(tbl.Rows.Count - 2)
Set r(5) = r(4).Offset(1)
Set r(6) = r(4).Offset(2)

f(1) = "=COUNTIFS(" & r(1).Address(, , xlR1C1) & ",rc," _
& r(2).Address(, , xlR1C1) & ",rc[1]," _
& r(3).Address(, , xlR1C1) & ",rc[2])>1"

f(2) = "=COUNTIFS(" & r(1).Address(, , xlR1C1) & ",rc[-1]," _
& r(2).Address(, , xlR1C1) & ",rc," _
& r(3).Address(, , xlR1C1) & ",rc[1])>1"

f(3) = "=COUNTIFS(" & r(1).Address(, , xlR1C1) & ",rc[-2]," _
& r(2).Address(, , xlR1C1) & ",rc[-1]," _
& r(3).Address(, , xlR1C1) & ",rc)>1"

f(4) = "=COUNTIFS(" & r(4).Address(, , xlR1C1) & ",rc," _
& r(5).Address(, , xlR1C1) & ",r[1]c," _
& r(6).Address(, , xlR1C1) & ",r[2]c)>1"

f(5) = "=COUNTIFS(" & r(4).Address(, , xlR1C1) & ",r[-1]c," _
& r(5).Address(, , xlR1C1) & ",rc," _
& r(6).Address(, , xlR1C1) & ",r[1]c)>1"

f(6) = "=COUNTIFS(" & r(4).Address(, , xlR1C1) & ",r[-2]c," _
& r(5).Address(, , xlR1C1) & ",r[-1]c," _
& r(6).Address(, , xlR1C1) & ",rc)>1"

tbl.FormatConditions.Delete

For k = 1 To 6
Set fc = r(k).FormatConditions.Add(Type:=xlExpression, Formula1:=f(k))
fc.Font.Underline = True
Next


End Sub



マナ