Fill cells with a specific shading with a hyperlink

Dear Experts:

I wonder if somebody could help me with the following:

My current worksheet has a 5000 data records.

I would like a VBA macro to perform the following actions on this data list:

... Go to the column header that says: 'Hyperlinks_Paths' (Column Headers are located in the first row)
... go down one cell so that the first cell right under the Column Header  'Hyperlinks_Paths' is the beginning of the range
... Set a range that spans down to the last filled cell in that column
... Insert a hyperlink (C:\MyFolder\DummyGraphic.png) in all the cells which have the following cell shading: RGB (222, 222, 222). Existing cell contents in these cells is to be overwritten with this Hyperlink text.

Help is much appreciated.

Thank you very much in advance for your professional help.

Regards, Andreas
Andreas HermleTeam leaderAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Steven HarrisPresidentCommented:
Please try the following:

Sub FillWithHyperlink()
'Fill cells with a specific shading with a hyperlink
    Dim rngAddress As Range
    Dim colorCell As Range
    Dim MyPath As String, MyFile As String, FriendlyName As String
    MyPath = "C:\MyFolder\"  'Your Folder Path
    MyFile = "DummyGraphic.png"  'Your File Name
    FriendlyName = "C:\MyFolder\DummyGraphic.png"  'What you call the Cell
    Set rngAddress = Range("A1:XFD1").Find("Hyperlinks_Paths")
    Application.ScreenUpdating = False
        If rngAddress Is Nothing Then
            MsgBox "Address column was not found."
        Exit Sub
        End If
    Range(rngAddress, rngAddress.End(xlDown)).Select
        For Each colorCell In Selection
            If colorCell.Interior.ColorIndex = 15 Then colorCell.Formula = "=HYPERLINK(""" & MyPath & MyFile & """,""" & FriendlyName & """)"
End Sub

Open in new window

Line 8 and 9 can be changed to suit your file path and file name.

You didn't specify a column for 'Hyperlinks_Paths', so this runs through the first line from A1 to XFD1.  You can shorten this to speed up the Macro

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Zack BarresseCEOCommented:
@ThinkSpaceSolutions: A couple of comments regarding your code, if you don't mind. Line 12 has two shortcomings. 1) You don't specify the worksheet for the Range() object, which you should always explicitly set. 2) You hard-code the range, which will make this not backwards compatible (and forward compatibility will have issues if they change the size of the worksheet again). Instead, think about using the Cells() method to just grab the number of columns the version of Excel is using. For example, if run on a 2003 machine there are only 256 columns and no XFD1 cell, so the code would bomb in older versions. Instead you could use...
With Worksheets("Sheet1")
    Set rngAddress = .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft)).Find("Hyperlinks_Paths")
End With

Open in new window

I generally set a variable for the worksheet, but opted for a With statement so you could see how I reference the Range() object explicitly.

Also, you should not have line 13 prior to your check if the rngAddress variable is Nothing, since ScreenUpdating doesn't reset itself.

As with line 12 above not referencing the worksheet, line 18 doesn't either. I would do it there as well. In addition to that you used the Select statement, which isn't needed at all. Instead, just replace line 19's "Selection" with line 18 (less the Select statement).

Zack Barresse
Steven HarrisPresidentCommented:
While those are valid points Zack, they are not necessarily shortcomings.  

1) I do not explicitly call a sheet so that the macro can be used on multiple sheets within a workbook.  the OP stated that "My current worksheet has a 5000 data records." so I took that to mean that this could grow exponentially, possibly into other sheets.

2) You are correct about the hard coding; however, it leaves more options for an inexperienced VBA user to manipulate if needed.

As for the ScreenUpdating, I honestly do not even remember setting that for this macro, as it is not really needed. :/
Python 3 Fundamentals

This course will teach participants about installing and configuring Python, syntax, importing, statements, types, strings, booleans, files, lists, tuples, comprehensions, functions, and classes.

Zack BarresseCEOCommented:
Humbly but definitively disagree. :) I see them as shortcomings to robust and efficient coding, especially if attempting to use best practices. If specifically asked for, I can see working on the active sheet, but nothing else besides that. It certainly should NOT be viewed to "leave more options for an inexperienced VBA user" regardless of what they want to manipulate. It's up to people like you and I to point these pitfalls and shortcomings to users. ;)

Steven HarrisPresidentCommented:
We shall agree to disagree then.  While you are right, and this would not be a code that I myself would use (for many reasons), this is a very basic and easy code using fundamental properties that can easily be manipulated by a novice who is willing and wanting to learn.  Once they can grasp some of the basics, they can move on to a level that you are proposing.
Andreas HermleTeam leaderAuthor Commented:
Dear both,

thank you very much for your swift and professiona support. I can understand both positions and therefore share the points.

thank you very much for your great help.

Regards, Andreas
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.