3

For example:

rngTo.Value = rngFrom.Value2 'Works
rngTo.NumberFormat = rngFrom.NumberFormat 'Works
rngTo.Cells.Interior.ColorIndex = rngFrom.Cells.Interior.ColorIndex 'Doesn't work
rngToPublish.Copy: rNG.PasteSpecial xlPasteFormats ' Does work

Is there any way to get this desired effect without using the PasteSpecial?

Nickolay
  • 31,095
  • 13
  • 107
  • 185
jason m
  • 6,519
  • 20
  • 69
  • 122
  • 2
    Value works because you can return (and Set) the Value of a multi-cell range, but there's no equivalent way to get at (eg) ColorIndex without looping through the range once cell at a time. Numberformat might have worked because all cells in rngFrom have the same format. – Tim Williams Oct 26 '11 at 22:51
  • 1
    Why are you trying to avoid paste special in the first place? – Reafidy Oct 27 '11 at 01:49
  • @Reafidy perhaps wanting to avoid pasting other aspects of the cell format? - if thats the case then looping over the range may be the only way – chris neilsen Oct 27 '11 at 06:04
  • OK, Jason, the updated code below will do it for you, with an explanation of why it wasn't working for you. – Jon49 Oct 27 '11 at 19:14
  • There is an addin for excel which adds more functionality for copying and pasting including only the fill colour: http://blog.livedoor.jp/andrewe/ – Reafidy Oct 27 '11 at 21:11
  • Reafidy- To avoid touching the global state and the related flakiness, similar to [reasons for avoiding `Select`](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). Unfortunately there doesn't seem to be a good replacement for `xlPasteFormats`... – Nickolay Feb 05 '20 at 12:17

2 Answers2

0

I like Tim's comment but also, look at what you are writing you have an extra Cells in there try it without the Cells and see if it works.

rngTo.Interior.ColorIndex = rngFrom.Interior.ColorIndex

Update: The above code only works when the colorindex is the same value over the whole range otherwise it doesn't work.

Update 2:

This will do it for you. What was going on before is that ColorIndex doesn't hold an array, only as single value so if it had multiple values it would return a Null value. Color also doesn't hold multiple values so it returns white if it contains multiple values.

Private Sub ColorRange()

    'Dim dicColors As Dictionary
    Dim dicColors As Object
    Dim dColor As Double
    Dim rCopy As Range, rPaste As Range, rNext As Range
    Dim wksCopy As Worksheet, wksPaste As Worksheet
    Dim vColor As Variant

    Set wksCopy = ActiveWorkbook.Worksheets("Sheet1")
    Set wksPaste = ActiveWorkbook.Worksheets("Sheet2")
    Set rCopy = wksCopy.UsedRange

    'Set dicColors = New Dictionary
    Set dicColors = CreateObject("Scripting.Dictionary")
    'Loop through entire range and get colors, place in dictionary.
    For Each rNext In rCopy
        dColor = rNext.Interior.Color
        If dicColors.Exists(dColor) Then
            Set dicColors(dColor) = Union(dicColors(dColor), wksPaste.Range(rNext.Address))
        Else
            Set rPaste = wksPaste.Range(rNext.Address)
            dicColors.Add dColor, rPaste
        End If
    Next rNext

    'Color the ranges
    For Each vColor In dicColors.Keys
        'If color isn't white then color it, otherwise leave black, if the 
        'worksheet you are copying to has colors already then you should do an
        'else statement to get rid of the coloring like this
        'dicColors(vColor).Interior.ColorIndex = xlNone
        If vColor <> 16777215 Then dicColors(vColor).Interior.Color = vColor
    Next vColor

End Sub
Jon49
  • 4,444
  • 4
  • 36
  • 73
  • This doesn't work Jon. Without wanting to sound condescending you should always test your code before posting, or as per Tim's standard approach, post anything that may not be a bullet proof answer as a comment – brettdj Oct 27 '11 at 00:14
  • No probs. FWIW I didn't provide the downvote - I figured that you would make appropriate edits so I held off to see what happened. – brettdj Oct 27 '11 at 06:01
  • Yeah, it's always nice if people would say why there is a down vote so we can all learn. Oh well, not a huge deal, just nice to help and it's nice to get help when needed. – Jon49 Oct 27 '11 at 06:26
  • Brett, had some extra time so it is now properly answered. – Jon49 Oct 27 '11 at 19:15
  • 1
    Jon, just a tip - if you use @brett he will get notified about your comment. I just learnt that not long ago myself. Agree with you about downvoting. – Reafidy Oct 27 '11 at 21:45
0

From the comments above you just want to copy fill colour, have a look at this example:

Sub CopyFillColour()

    Dim rCopy As Range, rPaste As Range
    Dim lRow As Long, lCol As Long

    Set rCopy = Range("A1:B4")
    Set rPaste = Range("C1:D4") '// Can be smaller than the copy range ie C1:C4

    For lRow = 1 To rPaste.Rows.Count
        For lCol = 1 To rPaste.Columns.Count
            rPaste(lRow, lCol).Interior.Color = rCopy(lRow, lCol).Interior.Color
            rPaste(lRow, lCol).Interior.Pattern = rCopy(lRow, lCol).Interior.Pattern
            rPaste(lRow, lCol).Interior.PatternColorIndex = rCopy(lRow, lCol).Interior.PatternColorIndex
        Next lCol
    Next lRow

End Sub

As much as I hate loops, this may be a case where you need them.

Reafidy
  • 8,240
  • 5
  • 51
  • 83