Highlight the reverse patterns

Kishan

Well-known Member
Joined
Mar 15, 2011
Messages
1,645
Office Version
  1. 2010
Platform
  1. Windows
Using Excel 2000</SPAN></SPAN>
Hi,
</SPAN></SPAN>

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....
</SPAN></SPAN>

Example....
</SPAN></SPAN>


Book1
ABCDEFGHIJKLMNOPQR
1
2
3
4
5P1P2P3P4P5P6P7P8P9P10P11P12P13P14
61212XX111112X2
72112XX2X1X1XX2
8XX11X111121X21
9211X12X1121XX1
10111X1X2121XX22
1112X1X112211122
1211212X112XX111
13XX1211X12121X1
1411211112X211XX
15X111222111X22X
161XX1X1X1221111
17X21XX1XX112111
182X1111X12XX11X
1911XX1X111X1X1X
20X2X11121111222
2122221222221X22
22XXX122X1X21121
2321X111X12211X2
2412X111X212112X
251X2X2XX11222X2
26X221X112XX2X11
271221221122XX21
28X1X21X212221X1
292XX212211X212X
30X1XX21XX2XXX11
31XX1112X1X11111
3222XXX11X122X2X
33211222XX12221X
34XX122X11XXX1XX
35
36
37
38
Sheet3


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

Regards,
</SPAN>
Kishan
</SPAN>
 
Last edited:

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
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
 
Upvote 0
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.</SPAN></SPAN>

Thank you so much for your support. have a good week
</SPAN>
</SPAN>
Kind Regards,
</SPAN></SPAN>
Kishan :)
</SPAN></SPAN>
 
Upvote 0
Using Excel 2000</SPAN></SPAN>
Hi,</SPAN></SPAN>

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


Book1
ABCDEFGHIJKLMNOPQR
1
2
3
4
5P1P2P3P4P5P6P7P8P9P10P11P12P13P14Count Reverse
61212XX111112X2
72112XX2X1X1XX21
8XX11X111121X21
9211X12X1121XX12
10111X1X2121XX22
1112X1X1122111221
1211212X112XX1112
13XX1211X12121X1
1411211112X211XX2
15X111222111X22X
161XX1X1X12211113
17X21XX1XX112111
182X1111X12XX11X
1911XX1X111X1X1X1
20X2X11121111222
2122221222221X224
22XXX122X1X21121
2321X111X12211X2
2412X111X212112X
251X2X2XX11222X21
26X221X112XX2X111
271221221122XX212
28X1X21X212221X11
292XX212211X212X1
30X1XX21XX2XXX11
31XX1112X1X11111
3222XXX11X122X2X
33211222XX12221X2
34XX122X11XXX1XX2
35
36
37
38
Sheet3


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

Regards,</SPAN>
Kishan</SPAN></SPAN>
 
Last edited:
Upvote 0
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
 
Upvote 0
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]
 
Last edited:
Upvote 0
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
:)
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]
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,526
Messages
6,114,122
Members
448,550
Latest member
CAT RG

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top