Search "x time" repeated and colour the cells

[Kishan]

Using Excel 2000</SPAN></SPAN>

Hi,</SPAN></SPAN>

I want a Formula or may be VBA that can search "x time" for selected value it can be "1", "X", or 2</SPAN></SPAN>

In the column C, there are data with repeated values in the cells C6 and below</SPAN></SPAN>

In the cell B1 is entered value "1" (it could be X or 2 also) which to be search in the column C</SPAN></SPAN>

In the cell B2 is entered value 3 it mean find 3 repeated values "1's" and (it could be 2 to 8) colour the cells </SPAN></SPAN>

Search method should be striate, for example once 3-repeated value find, look for next 3 do not look back you will see C16, 17, 18 find 3 repeated, but C19, C20 stand alone forget it. </SPAN></SPAN>

Checked value will be considered B1, and the repeated value of the cell B2 </SPAN></SPAN>

Some example of the data results</SPAN></SPAN>

Book1
	A	B	C	D	E
1	Check--->	1
2	Repeated->	3
3
4
5			P1
6			X
7			1
8			1
9			1
10			X
11			X
12			2
13			X
14			1
15			X
16			1
17			1
18			1
19			1
20			1
21			X
22			1
23			1
24			1
25			1
26			1
27			X
28			1
29			1
30			1
31			1
32			1
33			1
34			1
35			1
36			X
37			2
38			1
39			X
40			1
41			1
42			1
43			X
44			2
45			X
46			1
47			X
48			1
49			X
50			1
51			1
52			1
53			2
54			1
55			1
56			X
57			1
58			1
59			1
60			1
61			1
62			2
63			1
64			1
65			1
66			1
67			1
68			1
69			1
70			X
71			1
72			1
73			1
74			X
75			1
76			2
77			X
78			1
79			1
80			1
81			1
82			1
83			1
84			1
85			1
86			1
87			X
88			1
89			1
90			X
91			1
92			1
93			1
94			1
95			1
96			X
97			X
98
99
100
Sheet1

Thank you in advance</SPAN></SPAN>

Regards,</SPAN></SPAN>
Kishan </SPAN></SPAN>

 

[Nine Zero]

Hello,

Still working on this right now. But so far i got it to work for 1 and 3 just like the example, maybe you can work off of this...I will continue to work on it no worries lol

Sub CheckRep()
Dim r As Range
Dim LastRow, ci As Integer
Dim s As Worksheet
Dim c As Boolean
Set s = ActiveSheet
c = False
LastRow = s.Cells(s.Rows.Count, "C").End(xlUp).Row


For i = 6 To LastRow
    If (Cells(i, 3).Value = Cells(i, 3).Offset(1, 0).Value And Cells(i, 3).Offset(1, 0).Value = Cells(i, 3).Offset(2, 0).Value) Then
    If c = False Then ci = 37 Else ci = 40
        Cells(i, 3).Interior.ColorIndex = ci
        Cells(i + 1, 3).Interior.ColorIndex = ci
        Cells(i + 2, 3).Interior.ColorIndex = ci
        i = i + 2
    If c = False Then c = True Else c = False
    End If
Next i


End Sub

 

[Fluff]

How about

Sub Hilite()
   Dim i As Long, clr As Long
   Dim Chk As Variant
   Dim Rpt As Long
   
   Chk = Range("B1").Value
   Rpt = Range("B2").Value
   clr = 1
   For i = 6 To Range("C" & Rows.count).End(xlUp).Row
      If Range("C" & i).Value = Chk And Application.CountIf(Range("C" & i).Resize(Rpt), Chk) = Rpt Then
         Range("C" & i).Resize(Rpt).Interior.Color = Choose(clr, vbGreen, vbRed)
         i = i + Rpt - 1: clr = IIf(clr = 1, 2, 1)
      End If
   Next i
End Sub

 

[Nine Zero]

@Fluff

That is amazing, never knew about resize

Also question what does the ":" do i line 12?

 

[Fluff]

It allows you to put 2 lines of code on 1 line.
So it would normally be written like

i = i + Rpt - 1
clr = IIf(clr = 1, 2, 1)

 

[Kishan]

How about

Sub Hilite()
   Dim i As Long, clr As Long
   Dim Chk As Variant
   Dim Rpt As Long
   
   Chk = Range("B1").Value
   Rpt = Range("B2").Value
   clr = 1
   For i = 6 To Range("C" & Rows.count).End(xlUp).Row
      If Range("C" & i).Value = Chk And Application.CountIf(Range("C" & i).Resize(Rpt), Chk) = Rpt Then
         Range("C" & i).Resize(Rpt).Interior.Color = Choose(clr, vbGreen, vbRed)
         i = i + Rpt - 1: clr = IIf(clr = 1, 2, 1)
      End If
   Next i
End Sub

Amazing Fluff, code highlights even only 1 repeated, checked with over 50 repeated no problem!! At all, also it highlight in 2 alternative colours Perfect!!</SPAN></SPAN>

Thank you for your time and help </SPAN></SPAN>

Have a nice day</SPAN></SPAN>

Kind Regards,</SPAN></SPAN>
Kishan </SPAN></SPAN>


Please may I request could you add in it some more information, which I did not thought before</SPAN></SPAN>

Can be counted highlighted sets, like in the example post#1 there are 15 sets of 3, </SPAN></SPAN>So the counts 15 can be placed in the cell C2 if possible</SPAN></SPAN>

Thank you in advance</SPAN></SPAN>

Regards,</SPAN></SPAN>
Kishan </SPAN></SPAN>

 

[Kishan]

Hello,
Still working on this right now. But so far i got it to work for 1 and 3 just like the example, maybe you can work off of this...I will continue to work on it no worries lol

Hi Nine Zero, I do appreciate your interest helping to resolve it.</SPAN></SPAN>

Thank you so much</SPAN></SPAN>

Kind Regards,</SPAN></SPAN>
Kishan </SPAN></SPAN>

 

[Fluff]

How about

Sub Hilite()
   Dim i As Long, clr As Long, [COLOR=#ff0000]Qty As Long[/COLOR]
   Dim Chk As Variant
   Dim Rpt As Long
   
   Chk = Range("B1").Value
   Rpt = Range("B2").Value
   clr = 1
   For i = 6 To Range("C" & Rows.count).End(xlUp).Row
      If Range("C" & i).Value = Chk And Application.CountIf(Range("C" & i).Resize(Rpt), Chk) = Rpt Then
         Range("C" & i).Resize(Rpt).Interior.Color = Choose(clr, vbGreen, vbRed)
         i = i + Rpt - 1: clr = IIf(clr = 1, 2, 1)[COLOR=#ff0000]: Qty = Qty + 1[/COLOR]
      End If
   Next i
   [COLOR=#ff0000]Range("C2").Value = Qty[/COLOR]
End Sub

 

[Rick Rothstein]

It allows you to put 2 lines of code on 1 line.
So it would normally be written like

i = i + Rpt - 1
[B][COLOR="#FF0000"]clr = IIf(clr = 1, 2, 1)[/COLOR][/B]

You can replace the line of code I highlighted in red above with this and your macro will work the same...

clr = 3 - clr

The IIf function is a somewhat slow function (in the compiled version of VB, it is literally 5 times slower than doing a standard If..Else block), so if you can avoid it, that would be best.

 

[Kishan]

How about

Sub Hilite()
   Dim i As Long, clr As Long, [COLOR=#ff0000]Qty As Long[/COLOR]
   Dim Chk As Variant
   Dim Rpt As Long
   
   Chk = Range("B1").Value
   Rpt = Range("B2").Value
   clr = 1
   For i = 6 To Range("C" & Rows.count).End(xlUp).Row
      If Range("C" & i).Value = Chk And Application.CountIf(Range("C" & i).Resize(Rpt), Chk) = Rpt Then
         Range("C" & i).Resize(Rpt).Interior.Color = Choose(clr, vbGreen, vbRed)
         i = i + Rpt - 1: clr = IIf(clr = 1, 2, 1)[COLOR=#ff0000]: Qty = Qty + 1[/COLOR]
      End If
   Next i
   [COLOR=#ff0000]Range("C2").Value = Qty[/COLOR]
End Sub

Hi Fluff, it is a perfect solution.</SPAN></SPAN>

Thank you for assisting twice </SPAN></SPAN>

Kind Regards,</SPAN></SPAN>
Kishan </SPAN></SPAN>