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

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

Leave a Reply

Your email address will not be published. Required fields are marked *

You may use these HTML tags and attributes: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong>