MS Excel – VBA – Copy Gradient from One Cell or Range to Another

by Daniel Pineault

There was an interesting question asked on the Excel forum of UtterAccess. For some odd reason, it just intrigued me, and I had to find an answer (even though I am not an Excel guru it just stuck in the back of my mind).

The Question was really straightforward: How can one merely copy the Cell’s gradient fill properties from one Cell/Range to another? In this instance the Format painter was out of the question because they only wanted the fill properties and none of the other properties.

Below is a simple function that does exactly that.

'---------------------------------------------------------------------------------------
' Procedure : CopyGradient
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Copy a Cell/Range's gradient fill properties from one Cell/Range to another
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' FromRange : Range that contains the Gradient Fill to be copied
' ToRange   : Range you wish to copy the Gradient Fill to
'
' Usage:
' ~~~~~~
' CopyGradient Range("B5"), Range("A1")
' CopyGradient Sheet1.Range("B5"), Sheet2.Range("A1:B2")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2013-May-24                 Initial Release
'---------------------------------------------------------------------------------------
Function CopyGradient(FromRange As Range, ToRange As Range)
On Error Resume Next
    ToRange.ClearFormats
    ToRange.Interior.Pattern = FromRange.Interior.Pattern
    ToRange.Interior.Gradient.RectangleLeft = FromRange.Interior.Gradient.RectangleLeft
    ToRange.Interior.Gradient.RectangleRight = FromRange.Interior.Gradient.RectangleRight
    ToRange.Interior.Gradient.RectangleTop = FromRange.Interior.Gradient.RectangleTop
    ToRange.Interior.Gradient.RectangleBottom = FromRange.Interior.Gradient.RectangleBottom
    ToRange.Interior.Gradient.Degree = FromRange.Interior.Gradient.Degree
    ToRange.Interior.Gradient.ColorStops.Clear
 
    For i = 1 To FromRange.Interior.Gradient.ColorStops.Count
        With ToRange.Interior.Gradient.ColorStops.Add(i - 1)
            .ThemeColor = FromRange.Interior.Gradient.ColorStops(i).ThemeColor
            .TintAndShade = FromRange.Interior.Gradient.ColorStops(i).TintAndShade
            .Color = FromRange.Interior.Gradient.ColorStops(i).Color
        End With
    Next i
End Function

I hope this can help someone else out.

Also, you may be interest in my post MS Excel – VBA – Copy One Cell or Range Background to another Cell or Range

View ratings
Rate this article

Share and Enjoy

  • Google Plus
  • Facebook
  • LinkedIn
  • Twitter
  • Email
  • Print

Leave a Reply










Email
Print