CODE given - Highlighting corresponding cells

[Thulasiram]

Hello all,

I have a simple set like this:

A B C D E F -----> rng3
1.1 1 1 1 0 0 3
1.2 1 0 0 1 0 2
1.3 1 0 0 0 0 1
2.1 0 1 1 1 1 4
2.2 1 1 1 1 1 5
Rank 2 5 1 6 3 4 -----> rng1d

Assuming that letters A, C and D are highlighted (colorindex = 3), I
want to transform the same pattern to the corresponding cells in the
row starting with Rank. To achieve this I have written a code like
this:

Set rng1c = Sheet1.Columns(1).Find( _
What:="Rank", _
After:=Cells(Rows.Count, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

Set rng1d = rng1c.EntireRow

' rng1d.Interior.ColorIndex = 3 ---> this highlights the entire row
starting with 'Rank'

But, I want the corresponding cells in the rng1d to be highlighted
according to the cells that have been highlighted in rng3.

For example:

1. As we have assumed that A, C and D have been highlighted, the values
2,1,6 have to be highlighted in rng 1d respectively.

2. If we assume B, D and E is highlighted, the values 5,6,3 have to be
highlighted in rng 1d respectively.

I tried a code like this.. It doesnt work for some reason..

rng1d.Cells.Interior.ColorIndex = rng3.Cells.Interior.ColorIndex

I would deeply appreciate any help for this.

Thanks,
Thulasiram

 

[Guest]

Try this code:

Sub test()
Dim hlitrng As Range, rng3 As Range, rng1d As Range
rankRow = Columns(1).Find( _
What:="Rank", _
After:=Cells(Rows.Count, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False).Row
Set rng1d = Range("B" & rankRow & ":G" & rankRow)
Set rng3 = Range("B1:G1")
For Each cella In rng3
If cella.Interior.ColorIndex = 3 Then
If hlitrng Is Nothing Then
Set hlitrng = Intersect(rng1d, cella.EntireColumn)
Else
Set hlitrng = Union(hlitrng, Intersect(rng1d,
cella.EntireColumn))
End If
End If
Next cella
hlitrng.Interior.ColorIndex = 3
End Sub

Regards,
Stefi

„Thulasiram†ezt írta:

 

[Thulasiram]

Stefi,

Just tried your code.. It works perfect and does what I was looking
for. Thanks for your help. I appreciate it...