Transfer the colorindex of a cell to another, without using paste or pastespecial

[Thulasiram]

Hello people,

I would like to transfer the format of the cells (value and colorindex)
"without" using pastespecial or paste command. I have written a code
like this

Sub test()
Sheet2.Range("A1:A15").Value = Sheet1.Range("A1:A15").Value
Sheet2.Range("A1:A15").Interior.ColorIndex =
Sheet1.Range("A1:A15").Interior.ColorIndex
End Sub

Values are transferred but not the colorindex. How could the coloindex
of the cells be transferred without using the pastespecial command?

Please provide your help..

Thanks,
Thulasiram

 

[NickHK]

If all the cell have the same .colorIndex, you code will work. However, I
suspect this is not the case, hence the failure. So,

Dim Cell As Range

For Each Cell In Sheet1.Range("A1:A15")
Sheet2.Range(Cell.Address).Interior.ColorIndex =
Cell.Interior.ColorIndex
Next

NickHK

 

[Gary Keramidas]

i have something similar for a client. they use box codes and are listed in
u1:u8.
this code determines the cell colors and then formats the cells in u24:u357
accordingly. maybe it will give you an idea.

Set rng = ws.Range("U24:U357")

With rng
For Each cell In rng
Select Case cell.Value
Case "10R"
fClr = ws.Range("U1").Font.ColorIndex ' 2 'white
bClr = ws.Range("U1").Interior.ColorIndex ' 9 ' brown
Case "BAB"
fClr = ws.Range("U2").Font.ColorIndex ' 2 ' white
bClr = ws.Range("U2").Interior.ColorIndex ' 1 ' black
Case "BDM"
fClr = ws.Range("U3").Font.ColorIndex ' 1 'black
bClr = ws.Range("U3").Interior.ColorIndex ' 2 'white
Case "G-2"
fClr = ws.Range("U4").Font.ColorIndex ' 1 'black
bClr = ws.Range("U4").Interior.ColorIndex ' 3 'red
Case "Per-2"
fClr = ws.Range("U5").Font.ColorIndex ' 1 'black
bClr = ws.Range("U5").Interior.ColorIndex ' 48 'gray
Case "RT24"
fClr = ws.Range("U6").Font.ColorIndex ' 1 'black
bClr = ws.Range("U6").Interior.ColorIndex ' 39 'violet
Case "W-2" ' change color codes below
fClr = ws.Range("U7").Font.ColorIndex ' 2 'white
bClr = ws.Range("U7").Interior.ColorIndex ' 11 'dk blue
Case "X-2"
fClr = ws.Range("U8").Font.ColorIndex ' 1 'black
bClr = ws.Range("U8").Interior.ColorIndex ' 43 'green
End Select
cell.Interior.ColorIndex = bClr
cell.Font.ColorIndex = fClr
Debug.Print bClr & " " & fClr
Next
End With

 

[Thulasiram]

Fantastic Nick! Infact, I was tweaking something with For loop.. I
ended up facing errors. But, your code works perfect.. Nice usage of
the for loop for the question that I posted...

 

[Thulasiram]

Gary,

Thanks for ur initiative to help... I had a look at your code. It gave
an idea.. Nick's code solved the issue..

 

[Thulasiram]

Nick,

In the code below, I am trying to shift the values, a cell before in
the other sheet. Cell value is transferredas expected but not the
colorindex.

Is there any command like (cell.address-1).. Please help.

Sheet2.Range("B1:I1").Value = Sheet1.Range("C1:J1").Value
For Each cell In Sheet1.Range("C1:J1")
Sheet2.Range(cell.Address).Interior.ColorIndex =
cell.Interior.ColorIndex
Next

Thanks,
Thulasiram

 

[Thulasiram]

Nick,

In the code below, I am trying to shift the values, a cell before in
the other sheet. Cell value is transferred as expected but not the
colorindex.

Is there any command like (cell.address-1).. Please help.

Sheet2.Range("B1:I1").Value = Sheet1.Range("C1:J1").Value
For Each cell In Sheet1.Range("C1:J1")
Sheet2.Range(cell.Address).Interior.ColorIndex =
cell.Interior.ColorIndex
Next

Thanks,
Thulasiram

 

[Gary Keramidas]

look at the offset function


Sub test()

With Worksheets("Sheet1")
For Each cell In .Range("C1:J1")
Debug.Print cell.Address
Worksheets("Sheet2").Range(cell.Address).Offset(0, -1).Interior.ColorIndex =
3
Next
End With
End Sub

 

[NickHK]

Add an .Offset. e.g.

Sheet2.Range(cell.Address).Offset(0,-1).Interior.ColorIndex =
cell.Interior.ColorIndex

NickHK

 

[Thulasiram]

Hearty Thanks to Nick and Gary.. Code works great..