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 : Excel_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 is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: None required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' FromRange : Range that contains the Gradient Fill to be copied
' ToRange   : Range you wish to copy the Gradient Fill to
'
' Usage:
' ~~~~~~
' Excel_CopyGradient Range("B5"), Range("A1")
' Excel_CopyGradient Sheet1.Range("B5"), Sheet2.Range("A1:B2")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2013-05-24              Initial Release
' 2         2018-06-18              Made the code Option Explicit compliant
'                                   Changed Copyright
'---------------------------------------------------------------------------------------
Function Excel_CopyGradient(FromRange As Range, ToRange As Range)
    On Error Resume Next
    Dim i                     As Long

    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

2 responses on “MS Excel – VBA – Copy Gradient from One Cell or Range to Another

    1. Daniel Pineault Post author

      Jon,

      Not sure what to advise you. It works fine for me (I just quickly tested).

      “…does not work…” is very vague, can you provide any details? Do you get any messages? Can you provide the syntax you tried? You copy/paste the function into a standard module? It compiled without errors?