color cells

[oleg_v]

hi

i need a help with a macro that will color 2 cells with the same containment with the same color in range "q1:q42"

thanks

[Bob Phillips]

What does 'same containment' mean?

[oleg_v]

This means that what is writen in both cell is the same
For example Q8=45abc and Q30=45abc those two cells should
Be colored in the same color


Thanks

[Aussiebear]

Try using Conditional Formatting

Select Format | Conditional Formatting
In the dialog box select "Formula Is.."
In next field enter =COUNTIF($Q1:Q42,Q1)>1
Select Format Button & choose what ever colour blows your hair back
Keep clicking OK button to exit all dialog boxes.
Copy this formula down to Q42.

[oleg_v]

Hi
Thanks for the replay.
I prefer a macro because I will use the different work book every
Time and macro is much easier
About the coloring I need if Q8=Q42 color them with one color and if Q3=Q28 color them with
Different color

Thanks

[Aussiebear]

Try recording a macro with those suggested selections and post back the code if you need it amended.

What happened to the request in post #1 where you suggested the range was Q1:Q42?

[oleg_v]

hi
Sub SAME()
Dim Rng As Range
Dim cel As Range
Dim tgt As Range
k = 0
Dim i As Long, y As Long
y = Sheets("sheet1").Range("r65536").End(xlUp).row
Set tgt = Sheets("sheet2").Range("a3")
Set Rng = Range("r7:q" & y)
For Each cel In Rng
If Application.CountIf(Rng, cel) = 2 Then
cel.EntireRow.Copy

k = k + 1
tgt.Offset(i).PasteSpecial

i = i + 1
End If
Next
Sheets("sheet2").Select
Dim Found As Range, It
Dim h As Long, f

h = 2
f = 2

one:
h = h + 1
f = f + 1

y = Sheets("sheet2").Range("r65536").End(xlUp).row

myvar = Worksheets("Sheet2").Range("r" & h).Value

It = myvar 'InputBox("Enter search term")
Set Found = Columns("r").Find(What:=It, LookIn:=xlValues, LookAt:=xlWhole)
If Not Found Is Nothing Then
Range(Found.Address(False, False)).Select

Selection.EntireRow.Interior.ColorIndex = f
Cells.FindNext(After:=ActiveCell).Activate
Selection.EntireRow.Interior.ColorIndex = f
'MsgBox It & " found in " & Found.Address(False, False), vbInformation
Else
' MsgBox It & " not found.", vbExclamation
End If

'MsgBox k



If h < y Then
GoTo one
Else
Exit Sub
End If

End Sub


in the macro above i have completed what i desire but one thing i can not
do after about 60 loops the color index is not working
please advise what i should do

maybe i need to stop after 60 loops

thanks for all the help

[mdmackillop]

You are limited in the number of colours Excel can display

Sub Colours()
Dim i
i = 0
On Error Resume Next
Do Until Err <> 0
Cells(i + 1, 1) = i
Cells(i + 1, 2).Interior.ColorIndex = i
i = i + 1
Loop
MsgBox Err & " - " & Err.Description
End Sub

[oleg_v]

hi thanks

so i will stop the loop at 58 rounds

is it ok?

[Bob Phillips]

There are 56 items in the Excel colour palette pre-2007. In a standard colour palette, a number of those are duplicated, but you can set those duplicates to your own custom colours, but I doubt you will see the difference in 56 colours, it is too many.