VBA to determine column letter of currently selected cell

Dear Experts:

this nice macro, courtesy by rorya from EE, inserts graphics into Column D, linking them. The network paths for all these graphics (hyperlinks) are all located in Column C.

This great macro works just fine.

Could somebody help me tweak this code with the following requirements:

Line 15: The column letter should not be hard coded (that was my initial requirement) but dynamic, i.e. line 15 should be based on the column of the currently selected cell, ie. the column letter is to be dynamic.

Help is much appreciated. Thank you very much in advance.

Regards, Andreas

Sub InsertPictures_Linked_To_File()

' by rorya from EE

   Dim C                           As Range
   Dim Image                       As Picture
 If MsgBox("Would you like to add pictures to the active worksheet, linking them?" & vbCrLf & vbCrLf & _
 "There must be network paths as hyperlinks to draw the picture from!", vbQuestion + vbYesNo, "Insert Pictures into Column D") = vbNo Then
        Exit Sub
        End If

  On Error Resume Next
   For Each C In Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
      C.Offset(0, 1).Activate
            Set Image = ActiveSheet.Pictures.Insert(C.Value2) 'linktofile:=msoFalse
      With Image
         If .Height > Application.CentimetersToPoints(4) Then _
                  .ShapeRange.ScaleHeight Application.CentimetersToPoints(4) / .Height, msoCTrue
                  .TopLeftCell.RowHeight = Image.Height + 10

         If .Height > .Width Then
            With .ShapeRange
               .Rotation = 90
               .IncrementLeft .Height / 2 - .Width / 2
               .IncrementTop .Width / 2 - .Height / 2 + 5
            End With
        .TopLeftCell.RowHeight = Image.Width + 10
        Else: .ShapeRange.IncrementTop (5)
         End If
      End With
End Sub

Open in new window

Andreas HermleTeam leaderAsked:
Who is Participating?
zorvek (Kevin Jones)ConsultantCommented:

   For Each C In Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))


   For Each C In Range(ActiveCell.EntireColumn.Rows(2), ActiveCell.EntireColumn.Rows(Rows.Count).End(xlUp))

Andreas HermleTeam leaderAuthor Commented:
Hi Kevin,

thank you very much for your quick help. I will give it a try and let you know.

Regards, andreas
Rory ArchibaldCommented:
Purely for information (no points, please) you can also use Cells:

For Each C In Range(Cells(2, Activecell.Column), Cells(Rows.Count, Activecell.Column).End(xlUp))

Open in new window

Cloud Class® Course: Amazon Web Services - Basic

Are you thinking about creating an Amazon Web Services account for your business? Not sure where to start? In this course you’ll get an overview of the history of AWS and take a tour of their user interface.

Senthil BDeveloper, Data Modeler, Scrum MasterCommented:
You can use named range for this.

for ex:- Create a named range for "C2" as MyCell

to get
value - ThisWorkbook.Names("MyCell").RefersToRange.Value
column - ThisWorkbook.Names("MyCell").RefersToRange.Column
row - ThisWorkbook.Names("MyCell").RefersToRange.Row

to get value
num = SheetName.Cells(i, Nms("MyCell").RefersToRange.Column).Value

to assign value
SheetName.Cells(i, Nms("MyCell").RefersToRange.Column).Value = 10
Andreas HermleTeam leaderAuthor Commented:
Works great, exactly what I was looking for. Thank you very much.

Rory, thank you to you as well, I really appreciate it.

Regards, Andreas
Andreas HermleTeam leaderAuthor Commented:
To: senthilkumarsb

Hi, thank you very much for your great support. I will give it a try and then let you know.

Regards, Andreas
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.