CF, macro require

[Kishan]

Using Excel 2000
Hi,

VBA, conditional formatting macro in the columns C, D & E as shown colours for pattern in the C1:E4 and in the columns G, H & I as shown colours for pattern in the G3:I3

Example data

Book1
	A	B	C	D	E	F	G	H	I	J	K
1			1|1	1|X	X|X		1|1	X|1	2|1
2				1|2	X|2		1|X	X|X	2|X
3				X|1	2|X		1|2	X|2	2|2
4				2|1	2|2
5			P1	P2	P3		P1	P2	P3
6			X|1	1|1	2|1		X|1	1|1	2|1
7			X|X	2|1	X|X		X|X	2|1	X|X
8			X|1	1|1	2|1		X|1	1|1	2|1
9			2|1	1|X	2|1		2|1	1|X	2|1
10			1|X	1|X	1|1		1|X	1|X	1|1
11			X|2	X|X	2|X		X|2	X|X	2|X
12			X|1	1|2	1|1		X|1	1|2	1|1
13			1|X	X|2	1|X		1|X	X|2	1|X
14			1|1	1|2	X|X		1|1	1|2	X|X
15			1|X	X|1	1|1		1|X	X|1	1|1
16			X|1	X|2	1|2		X|1	X|2	1|2
17			1|1	X|1	2|1		1|1	X|1	2|1
18			1|1	1|1	1|X		1|1	1|1	1|X
19			X|1	1|X	X|1		X|1	1|X	X|1
20			1|1	1|1	2|1		1|1	1|1	2|1
21			1|1	1|2	2|1		1|1	1|2	2|1
22			2|1	X|1	1|X		2|1	X|1	1|X
23			1|1	1|1	1|2		1|1	1|1	1|2
24			X|1	1|2	1|1		X|1	1|2	1|1
25			1|1	1|1	X|1		1|1	1|1	X|1
26			X|1	1|1	1|2		X|1	1|1	1|2
27			1|2	X|X	X|X		1|2	X|X	X|X
28			1|1	1|2	1|2		1|1	1|2	1|2
29			1|1	1|2	2|1		1|1	1|2	2|1
30			1|1	1|X	1|1		1|1	1|X	1|1
31			1|1	1|X	1|1		1|1	1|X	1|1
32			1|X	1|1	2|1		1|X	1|1	2|1
33			2|2	1|1	X|1		2|2	1|1	X|1
34			1|X	1|2	1|1		1|X	1|2	1|1
35			2|1	1|1	2|X		2|1	1|1	2|X
36			1|X	X|2	1|1		1|X	X|2	1|1
37			X|1	1|1	1|1		X|1	1|1	1|1
38			X|2	1|1	X|X		X|2	1|1	X|X
39			X|1	2|1	2|1		X|1	2|1	2|1
40			1|1	1|X	X|1		1|1	1|X	X|1
41			2|X	1|1	1|1		2|X	1|1	1|1
42			X|2	X|1	1|1		X|2	X|1	1|1
43
44
45
46
Sheet1

Thank you in advance

Regards,
Kishan

 

[6StringJazzer]

Why do you need VBA for this? It could be done with 6 conditional formatting rules.

 

[Kishan]

Why do you need VBA for this? It could be done with 6 conditional formatting rules.

6StringJazzer, I am already using formulas in the example i have shown 2 set one in columns C:E & other in columns G:I, </SPAN></SPAN>
But actually it is one set in C:E columns so I want macro,..... if I run A macro it colours cell as per C1:E4, and if I run B macro it colours cell as per G3:I3</SPAN></SPAN>

Hope it is clarified</SPAN></SPAN>

 

[KolGuyXcel]

Modify the color codes to suit your choices! I'm not good with the color codes!

Sub color_cells_1()
Dim lr As Long, cell_co As Range
lr = WorksheetFunction.Max(Cells(Rows.Count, 3).End(xlUp).Row, Cells(Rows.Count, 4).End(xlUp).Row, Cells(Rows.Count, 5).End(xlUp).Row)
Set cell_co = Range("C6:E" & lr)
For Each cell In cell_co
If cell.Value2 = "1|1" Then
cell.Interior.Color = vbRed
ElseIf cell.Value2 = "1|x" Or cell.Value2 = "1|2" Or cell.Value2 = "X|1" Or cell.Value2 = "2|1" Then
cell.Interior.Color = vbGreen
ElseIf cell.Value2 = "X|X" Or cell.Value2 = "X|2" Or cell.Value2 = "2|X" Or cell.Value2 = "2|2" Then
cell.Interior.Color = vbBlue
End If
Next
End Sub
Sub color_cells_2()
Dim lr As Long, cell_co As Range
lr = WorksheetFunction.Max(Cells(Rows.Count, 3).End(xlUp).Row, Cells(Rows.Count, 4).End(xlUp).Row, Cells(Rows.Count, 5).End(xlUp).Row)
Set cell_co = Range("C6:E" & lr)
For Each cell In cell_co
If cell.Value2 = "1|1" Or cell.Value2 = "1|X" Or cell.Value2 = "X|1" Then
cell.Interior.Color = vbRed
ElseIf cell.Value2 = "X|1" Or cell.Value2 = "X|X" Or cell.Value2 = "X|2" Then
cell.Interior.Color = vbGreen
ElseIf cell.Value2 = "2|1" Or cell.Value2 = "2|X" Or cell.Value2 = "2|2" Then
cell.Interior.Color = vbBlue
End If
Next
End Sub

 

[Rick Rothstein]

I do not know if the following will work in your version of Excel (XL2000) or not, but it works fine in my version of Excel (XL2010). Try it and let me know...

[table="width: 500"]
[tr]
	[td]Sub ColorCells()
  Dim Cell As Range, Rng(-1 To 0) As Range
  Set Rng(-1) = Range("C10", Cells(Rows.Count, "E").End(xlUp))
  Set Rng(0) = Range("G10", Cells(Rows.Count, "I").End(xlUp))
  Application.ReplaceFormat.Clear
  For Each Cell In Range("C5:I8")
    If Cell.Interior.ColorIndex <> xlColorIndexNone Then
      Application.ReplaceFormat.Interior.Color = Cell.Interior.Color
      Application.ReplaceFormat.Font.Color = vbWhite
      Application.ReplaceFormat.Font.Bold = True
      Rng(Cell.Column < 6).Replace Cell.Value, "", SearchFormat:=False, ReplaceFormat:=True
    End If
  Next
  Application.ReplaceFormat.Clear
End Sub[/td]
[/tr]
[/table]

 

[Kishan]

I do not know if the following will work in your version of Excel (XL2000) or not, but it works fine in my version of Excel (XL2010). Try it and let me know...

Hi Rick, code stop at "SearchFormat:=False," if I eliminate this than stop at "ReplaceFormat:=True" and popup message Argument do not find

 

[Kishan]

Modify the color codes to suit your choices! I'm not good with the color codes!

Hi KolGuyXcel, thank you it worked just modified the colours as I needed</SPAN></SPAN>

Sub color_cells_1()
Dim lr As Long, cell_co As Range
lr = WorksheetFunction.Max(Cells(Rows.Count, 3).End(xlUp).Row, Cells(Rows.Count, 4).End(xlUp).Row, Cells(Rows.Count, 5).End(xlUp).Row)
Set cell_co = Range("C6:E" & lr)
For Each Cell In cell_co
If Cell.Value2 = "1|1" Then
'Cell.Interior.Color = vbRed
[COLOR=#ff0000]Cell.Interior.ColorIndex = 3
Cell.Font.ColorIndex = 2
[/COLOR]ElseIf Cell.Value2 = "1|X" Or Cell.Value2 = "1|2" Or Cell.Value2 = "X|1" Or Cell.Value2 = "2|1" Then
'Cell.Interior.Color = vbGreen
[COLOR=#006400]Cell.Interior.ColorIndex = 10
Cell.Font.ColorIndex = 2
[/COLOR]ElseIf Cell.Value2 = "X|X" Or Cell.Value2 = "X|2" Or Cell.Value2 = "2|X" Or Cell.Value2 = "2|2" Then
'Cell.Interior.Color = vbBlue
[COLOR=#0000ff]Cell.Interior.ColorIndex = 5
Cell.Font.ColorIndex = 2
[/COLOR]End If
Next
End Sub


Sub color_cells_2()
Dim lr As Long, cell_co As Range
lr = WorksheetFunction.Max(Cells(Rows.Count, 3).End(xlUp).Row, Cells(Rows.Count, 4).End(xlUp).Row, Cells(Rows.Count, 5).End(xlUp).Row)
Set cell_co = Range("C6:E" & lr)
For Each Cell In cell_co
If Cell.Value2 = "1|1" Or Cell.Value2 = "1|X" Or Cell.Value2 = "1|2" Then
'Cell.Interior.Color = vbRed
[COLOR=#ff0000]Cell.Interior.ColorIndex = 3
Cell.Font.ColorIndex = 2
[/COLOR]ElseIf Cell.Value2 = "X|1" Or Cell.Value2 = "X|X" Or Cell.Value2 = "X|2" Then
'Cell.Interior.Color = vbGreen
[COLOR=#006400]Cell.Interior.ColorIndex = 10
Cell.Font.ColorIndex = 2
[/COLOR]ElseIf Cell.Value2 = "2|1" Or Cell.Value2 = "2|X" Or Cell.Value2 = "2|2" Then
'Cell.Interior.Color = vbBlue
[COLOR=#0000ff]Cell.Interior.ColorIndex = 5
Cell.Font.ColorIndex = 2[/COLOR]
End If
Next
End Sub

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

 

[Rick Rothstein]

Hi Rick, code stop at "SearchFormat:=False," if I eliminate this than stop at "ReplaceFormat:=True" and popup message Argument do not find

Yeah, that is what I was afraid of. How about this code... does it work on your system?

[table="width: 500"]
[tr]
	[td]Sub ColorCells()
  Dim X As Long, LastRow As Long, Cell As Range, Codes As String, Dict(-1 To 0) As Object
  Set Dict(-1) = CreateObject("Scripting.Dictionary")
  Set Dict(0) = CreateObject("Scripting.Dictionary")
  For Each Cell In Range("C5:I8")
    If Len(Cell.Value) Then Dict(Cell.Column < 6).Item(Cell.Value) = Cell.Interior.Color
  Next
  LastRow = Cells.Find("*", , xlValues, , xlRows, xlPrevious, , , False).Row
  Application.ScreenUpdating = False
  For Each Cell In Union(Range("C10:E" & LastRow), Range("G10:I" & LastRow))
    If Len(Cell.Value) Then
      Cell.Interior.Color = Dict(Cell.Column < 6).Item(Cell.Value)
      Cell.Font.Color = vbWhite
      Cell.Font.Bold = True
    End If
  Next
  Application.ScreenUpdating = True
End Sub[/td]
[/tr]
[/table]

 

[Kishan]

Yeah, that is what I was afraid of. How about this code... does it work on your system?

Hi Rick, thank you code stuck at ".Find" pop up message number of arguments are not correct if I do modify "xlPrevious, , , False" to "xlPrevious, False" code run and present result as shown below

Book1
	A	B	C	D	E	F	G	H	I	J	K
1			1|1	1|X	X|X		1|1	X|1	2|1
2				1|2	X|2		1|X	X|X	2|X
3				X|1	2|X		1|2	X|2	2|2
4				2|1	2|2
5			P1	P2	P3		P1	P2	P3
6			X|1	1|1	2|1		X|1	1|1	2|1
7			X|X	2|1	X|X		X|X	2|1	X|X
8			X|1	1|1	2|1		X|1	1|1	2|1
9			2|1	1|X	2|1		2|1	1|X	2|1
10			1|X	1|X	1|1		1|X	1|X	1|1
11			X|2	X|X	2|X		X|2	X|X	2|X
12			X|1	1|2	1|1		X|1	1|2	1|1
13			1|X	X|2	1|X		1|X	X|2	1|X
14			1|1	1|2	X|X		1|1	1|2	X|X
15			1|X	X|1	1|1		1|X	X|1	1|1
16			X|1	X|2	1|2		X|1	X|2	1|2
17			1|1	X|1	2|1		1|1	X|1	2|1
18			1|1	1|1	1|X		1|1	1|1	1|X
19			X|1	1|X	X|1		X|1	1|X	X|1
20			1|1	1|1	2|1		1|1	1|1	2|1
21			1|1	1|2	2|1		1|1	1|2	2|1
22			2|1	X|1	1|X		2|1	X|1	1|X
23			1|1	1|1	1|2		1|1	1|1	1|2
24			X|1	1|2	1|1		X|1	1|2	1|1
25			1|1	1|1	X|1		1|1	1|1	X|1
26			X|1	1|1	1|2		X|1	1|1	1|2
27			1|2	X|X	X|X		1|2	X|X	X|X
28			1|1	1|2	1|2		1|1	1|2	1|2
29			1|1	1|2	2|1		1|1	1|2	2|1
30			1|1	1|X	1|1		1|1	1|X	1|1
31			1|1	1|X	1|1		1|1	1|X	1|1
32			1|X	1|1	2|1		1|X	1|1	2|1
33			2|2	1|1	X|1		2|2	1|1	X|1
34			1|X	1|2	1|1		1|X	1|2	1|1
35			2|1	1|1	2|X		2|1	1|1	2|X
36			1|X	X|2	1|1		1|X	X|2	1|1
37			X|1	1|1	1|1		X|1	1|1	1|1
38			X|2	1|1	X|X		X|2	1|1	X|X
39			X|1	2|1	2|1		X|1	2|1	2|1
40			1|1	1|X	X|1		1|1	1|X	X|1
41			2|X	1|1	1|1		2|X	1|1	1|1
42			X|2	X|1	1|1		X|2	X|1	1|1
43
44
45
46
Sheet1

Regards,
Kishan

 

[Rick Rothstein]

Hi Rick, thank you code stuck at ".Find" pop up message number of arguments are not correct

Okay, how about this then....

[table="width: 500"]
[tr]
	[td]Sub ColorCells()
  Dim X As Long, LastRow As Long, Cell As Range, Codes As String, Dict(-1 To 0) As Object
  Set Dict(-1) = CreateObject("Scripting.Dictionary")
  Set Dict(0) = CreateObject("Scripting.Dictionary")
  For Each Cell In Range("C5:I8")
    If Len(Cell.Value) Then Dict(Cell.Column < 6).Item(Cell.Value) = Cell.Interior.Color
  Next
  LastRow = Cells.Find("*", , xlValues, , xlRows, xlPrevious, , , False).Row
  Application.ScreenUpdating = False
  For Each Cell In Union(Range("C10:E" & LastRow), Range("G10:I" & LastRow))
    If Len(Cell.Value) Then
      Cell.Interior.Color = Dict(Cell.Column < 6).Item(Cell.Value)
      Cell.Font.Color = vbWhite
      Cell.Font.Bold = True
    End If
  Next
  Application.ScreenUpdating = True
End Sub[/td]
[/tr]
[/table]