Highlight the reverse patterns

Kishan · Sep 23, 2019

Using Excel 2000
Hi,

I need to highlight all the reverse patterns of column C&D are find in the Columns E&F, G&H, I&J, K&L, M&N And in the O&P and want to be highlighted colours as shown in the example including C&D column... for Example C7:D7=2&1, reverse of it find in E7&F7=1&2 to be highlighted in blue....

Example....

Book1

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

1

2

3

4

5

P1

P2

P3

P4

P5

P6

P7

P8

P9

P10

P11

P12

P13

P14

6

1

2

1

2

X

1

2

X

2

7

2

1

2

X

2

X

1

X

1

X

2

8

X

1

X

1

2

1

X

2

1

9

2

1

X

1

2

X

1

2

1

X

1

10

1

X

1

X

2

1

2

1

X

2

11

1

2

X

1

X

1

2

1

2

12

1

2

1

2

X

1

2

X

1

13

X

1

2

1

X

1

2

1

2

1

X

1

14

1

2

1

2

X

2

1

X

15

X

1

2

1

X

2

X

16

1

X

1

X

1

X

1

2

1

17

X

2

1

X

1

X

1

2

1

18

2

X

1

X

1

2

X

1

X

19

1

X

1

X

1

X

1

X

1

X

20

X

2

X

1

2

1

2

21

2

1

2

1

X

2

22

X

1

2

X

1

X

2

1

2

1

23

2

1

X

1

X

1

2

1

X

2

24

1

2

X

1

X

2

1

2

1

2

X

25

1

X

2

X

2

X

1

2

X

2

26

X

2

1

X

1

2

X

2

X

1

27

1

2

1

2

1

2

X

2

1

28

X

1

X

2

1

X

2

1

2

1

X

1

29

2

X

2

1

2

1

X

2

1

2

X

30

X

1

X

2

1

X

2

X

1

31

X

1

2

X

1

X

1

32

2

X

1

X

1

2

X

2

X

33

2

1

2

X

1

2

1

X

34

X

1

2

X

1

X

1

X

35

36

37

38

Sheet3

Thank you in advance

Regards,
Kishan

Rick Rothstein · Sep 23, 2019

Give this macro a try...

Code:

Sub ColorReversals()
  Dim R As Long, C As Long
  For R = 6 To Cells(Rows.Count, "C").End(xlUp).Row
    For C = 5 To 15 Step 2
      If Cells(R, 4).Value & Cells(R, 3).Value = Cells(R, C).Value & Cells(R, C + 1).Value Then
        Cells(R, 3).Resize(, 2).Interior.Color = Range("C5").Interior.Color
        Cells(R, C).Resize(, 2).Interior.Color = Cells(5, C).Interior.Color
      End If
    Next
  Next
End Sub

Kishan · Sep 23, 2019

Rick Rothstein said:

Give this macro a try...

Code:

Sub ColorReversals()
  Dim R As Long, C As Long
  For R = 6 To Cells(Rows.Count, "C").End(xlUp).Row
    For C = 5 To 15 Step 2
      If Cells(R, 4).Value & Cells(R, 3).Value = Cells(R, C).Value & Cells(R, C + 1).Value Then
        Cells(R, 3).Resize(, 2).Interior.Color = Range("C5").Interior.Color
        Cells(R, C).Resize(, 2).Interior.Color = Cells(5, C).Interior.Color
      End If
    Next
  Next
End Sub

Rick Rothstein, speech less it is a great worked, as I required.

Thank you so much for your support. have a good week

Kind Regards,
Kishan

Kishan · Sep 23, 2019

Using Excel 2000
Hi,

Does it is possible have separate macro which can count reverse patterns in the column R as per shown in example below...

Book1

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

1

2

3

4

5

P1

P2

P3

P4

P5

P6

P7

P8

P9

P10

P11

P12

P13

P14

Count Reverse

6

1

2

1

2

X

1

2

X

2

7

2

1

2

X

2

X

1

X

1

X

2

1

8

X

1

X

1

2

1

X

2

1

9

2

1

X

1

2

X

1

2

1

X

1

2

10

1

X

1

X

2

1

2

1

X

2

11

1

2

X

1

X

1

2

1

2

1

12

1

2

1

2

X

1

2

X

1

2

13

X

1

2

1

X

1

2

1

2

1

X

1

14

1

2

1

2

X

2

1

X

2

15

X

1

2

1

X

2

X

16

1

X

1

X

1

X

1

2

1

3

17

X

2

1

X

1

X

1

2

1

18

2

X

1

X

1

2

X

1

X

19

1

X

1

X

1

X

1

X

1

X

1

20

X

2

X

1

2

1

2

21

2

1

2

1

X

2

4

22

X

1

2

X

1

X

2

1

2

1

23

2

1

X

1

X

1

2

1

X

2

24

1

2

X

1

X

2

1

2

1

2

X

25

1

X

2

X

2

X

1

2

X

2

1

26

X

2

1

X

1

2

X

2

X

1

27

1

2

1

2

1

2

X

2

1

2

28

X

1

X

2

1

X

2

1

2

1

X

1

29

2

X

2

1

2

1

X

2

1

2

X

1

30

X

1

X

2

1

X

2

X

1

31

X

1

2

X

1

X

1

32

2

X

1

X

1

2

X

2

X

33

2

1

2

X

1

2

1

X

2

34

X

1

2

X

1

X

1

X

2

35

36

37

38

Sheet3

Thank you in advance

Regards,
Kishan

salim hasan · Sep 23, 2019

Try This Macro

Code:

Option Explicit
Sub Count_For_Me()
Const Col3 = 3
Const Col4 = 4
Dim i%, col%, k
Dim last_ro%: last_ro = Cells(Rows.Count, "C").End(3).Row
Range("E6").Resize(last_ro - 5, 12).Interior.ColorIndex = xlNone
Range("R6").Resize(last_ro - 5).ClearContents
For i = 6 To last_ro
   For col = 5 To 15 Step 2
      If Cells(i, Col4) <> vbNullString Or _
         Cells(i, Col3) <> vbNullString Then
          If Cells(i, Col4) & Cells(i, Col3) = _
            Cells(i, col) & Cells(i, col + 1) Then
            Cells(i, col).Resize(, 2).Interior.ColorIndex = _
            Cells(i, Col3).Interior.ColorIndex
            k = k + 1
          End If
       End If
    Next col
    Cells(i, "R") = IIf(k = 0, "", k): k = 0
Next i
End Sub

salim hasan · Sep 23, 2019

You can switch the code with this code because it is faster For empty cells

Code:

[COLOR=#574123][COLOR=#333333][INDENT]Option Explicit
Sub Count_For_Me()
Const Col3 = 3
Const Col4 = 4
Dim i%, col%, k
Dim last_ro%: last_ro = Cells(Rows.Count, "C").End(3).Row
Range("E6").Resize(last_ro - 5, 12).Interior.ColorIndex = xlNone
Range("R6").Resize(last_ro - 5).ClearContents
For i = 6 To last_ro
   For col = 5 To 15 Step 2
      [COLOR=#ff0000]If[/COLOR] Cells(i, Col4) = vbNullString Or _
         Cells(i, Col3) = vbNullString Then ُ[COLOR=#ff0000]Exit For[/COLOR]
          If Cells(i, Col4) & Cells(i, Col3) = _
            Cells(i, col) & Cells(i, col + 1) Then
            Cells(i, col).Resize(, 2).Interior.ColorIndex = _
            Cells(i, Col3).Interior.ColorIndex
            k = k + 1
          End If
    Next col
    Cells(i, "R") = IIf(k = 0, "", k): k = 0
Next i
End Sub
[/INDENT]
[/COLOR][/COLOR][COLOR=#574123][B][RIGHT][/RIGHT]
[/B][/COLOR]

Kishan · Sep 23, 2019

salim hasan, the code were removing Rick Rothstein code formatted cell and were coping the format of P1-P2 for to all over area. For that I remove the following lines in the colour red. And also there were "?" removed the "?" from the line marked in the colour blue, doing so code count worked fine.

Thank you so much for your support. have a great week

Kind Regards,
Kishan

salim hasan said:

You can switch the code with this code because it is faster For empty cells

Code:

[COLOR=#574123][COLOR=#333333][INDENT]Option Explicit
Sub Count_For_Me()
Const Col3 = 3
Const Col4 = 4
Dim i%, col%, k
Dim last_ro%: last_ro = Cells(Rows.Count, "C").End(3).Row
[COLOR=#ff0000]'Range("E6").Resize(last_ro - 5, 12).Interior.ColorIndex = xlNone[/COLOR]
Range("R6").Resize(last_ro - 5).ClearContents
For i = 6 To last_ro
   For col = 5 To 15 Step 2
       [COLOR=#0000ff]If Cells(i, Col14) = vbNullString Or _[/COLOR][COLOR=#0000ff]         
           Cells(i, Col13) = vbNullString Then Exit For[/COLOR]
          If Cells(i, Col4) & Cells(i, Col3) = _
            Cells(i, col) & Cells(i, col + 1) Then
            [COLOR=#ff0000] 'Cells(i, col).Resize(, 2).Interior.ColorIndex = _[/COLOR]
             [COLOR=#ff0000]'Cells(i, Col3).Interior.ColorIndex[/COLOR]
            k = k + 1
          End If
    Next col
    Cells(i, "R") = IIf(k = 0, "", k): k = 0
Next i
End Sub
[/INDENT]
[/COLOR][/COLOR]

Highlight the reverse patterns

Kishan

Well-known Member

Excel Facts

Rick Rothstein

MrExcel MVP

Kishan

Well-known Member

Kishan

Well-known Member

salim hasan

Board Regular

salim hasan

Board Regular

Kishan

Well-known Member

Similar threads

Forum statistics

Share this page

Highlight the reverse patterns

Kishan

Well-known Member

Excel Facts

Rick Rothstein

MrExcel MVP

Kishan

Well-known Member

Kishan

Well-known Member

salim hasan

Board Regular

salim hasan

Board Regular

Kishan

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock