I'm trying to insert pics based on values that appear in a cell. I
have this code and I've got it to work by hardcoding values. Since I
have like 500 variables, I'd like to steer clear of hardcoding. What
I need help with is selecting the Column to look in and then finding
the correct value
I know this code doesn't work but it should provide direction to what
I'd like to happen.


Dim CellLoop As Range
Dim CellVal As String
CellLoop = Range("G:G")
CellVal = ActiveCell.FormulaR1C1

'Don't Know how to get this to work
Select Case CellVal in CellLoop
Case 1
InsertPicture "C:\Users\mbramer\Desktop\R_RImages\1.jpg",
_
ActiveCell.Offset(0, -2), True, True
Case 2
InsertPicture "C:\Users\mbramer\Desktop\R_RImages\2.jpg",
_
ActiveCell.Offset(0, -2), True, True
Case Else
MsgBox ("Wrong Values")
End Select


Thanks for your help!
Regards,
Matt

Maybe...

Option Explicit
Sub testme()
Dim myPath As String
Dim myRng As Range
Dim myCell As Range
Dim TestStr As String
Dim myPict As Picture
Dim myPictName As String
Dim myRatio As Double

'change to the correct location of the picture files
myPath = "C:\Users\mbramer\Desktop\R_RImages"
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

With Worksheets("Sheet1")
.Pictures.Delete 'remove any existing pictures???
Set myRng = .Range("G1", .Cells(.Rows.Count, "G").End(xlUp))

For Each myCell In myRng.Cells
myPictName = myPath & myCell.Value & ".jpg"
TestStr = ""
On Error Resume Next
TestStr = Dir(myPictName)
On Error GoTo 0
If TestStr = "" Then
MsgBox "Pictu " & myPictName & " wasn't found"
Else
Set myPict = .Pictures.Insert(myPictName)
With myCell.Offset(0, 1)
myPict.ShapeRange.LockAspectRatio = msoFalse
myRatio = myPict.Width / myPict.Height
myPict.Top = .Top
myPict.Left = .Left
myPict.Height = .Height
myPict.Width = .Height * myRatio
myPict.Name = "Pict_" & .Address(0, 0)
myPict.ShapeRange.LockAspectRatio = msoTrue
End With
End If
Next myCell
End With
End Sub


=====
It looks in G1:G(lastusedrow) and uses the name in that cell to insert a picture
in column H.

The value in column G shouldn't include the path or the extension. This line
creates the path, filename and extension.

myPictName = myPath & myCell.Value & ".jpg"

If you already have ".jpg" in the cell, you can drop it off this line of code:
myPictName = myPath & myCell.Value




RemyMaza wrote:

I'm trying to insert pics based on values that appear in a cell. I
have this code and I've got it to work by hardcoding values. Since I
have like 500 variables, I'd like to steer clear of hardcoding. What
I need help with is selecting the Column to look in and then finding
the correct value
I know this code doesn't work but it should provide direction to what
I'd like to happen.

Dim CellLoop As Range
Dim CellVal As String
CellLoop = Range("G:G")
CellVal = ActiveCell.FormulaR1C1

'Don't Know how to get this to work
Select Case CellVal in CellLoop
Case 1
InsertPicture "C:\Users\mbramer\Desktop\R_RImages\1.jpg",
_
ActiveCell.Offset(0, -2), True, True
Case 2
InsertPicture "C:\Users\mbramer\Desktop\R_RImages\2.jpg",
_
ActiveCell.Offset(0, -2), True, True
Case Else
MsgBox ("Wrong Values")
End Select

Thanks for your help!
Regards,
Matt

--

Dave Peterson

On May 5, 5:21*pm, Dave Peterson wrote:
Maybe...

Option Explicit
Sub testme()
* * Dim myPath As String
* * Dim myRng As Range
* * Dim myCell As Range
* * Dim TestStr As String
* * Dim myPict As Picture
* * Dim myPictName As String
* * Dim myRatio As Double

* * 'change to the correct location of the picture files
* * myPath = "C:\Users\mbramer\Desktop\R_RImages"
* * If Right(myPath, 1) < "\" Then
* * * * myPath = myPath & "\"
* * End If

* * With Worksheets("Sheet1")
* * * * .Pictures.Delete 'remove any existing pictures???
* * * * Set myRng = .Range("G1", .Cells(.Rows.Count, "G").End(xlUp))

* * * * For Each myCell In myRng.Cells
* * * * * * myPictName = myPath & myCell.Value & ".jpg"
* * * * * * TestStr = ""
* * * * * * On Error Resume Next
* * * * * * TestStr = Dir(myPictName)
* * * * * * On Error GoTo 0
* * * * * * If TestStr = "" Then
* * * * * * * * MsgBox "Pictu " & myPictName & " wasn't found"
* * * * * * Else
* * * * * * * * Set myPict = .Pictures.Insert(myPictName)
* * * * * * * * With myCell.Offset(0, 1)
* * * * * * * * * * myPict.ShapeRange.LockAspectRatio = msoFalse
* * * * * * * * * * myRatio = myPict.Width / myPict.Height
* * * * * * * * * * myPict.Top = .Top
* * * * * * * * * * myPict.Left = .Left
* * * * * * * * * * myPict.Height = .Height
* * * * * * * * * * myPict.Width = .Height * myRatio
* * * * * * * * * * myPict.Name = "Pict_" & .Address(0, 0)
* * * * * * * * * * myPict.ShapeRange.LockAspectRatio = msoTrue
* * * * * * * * End With
* * * * * * End If
* * * * Next myCell
* * End With
End Sub

=====
It looks in G1:G(lastusedrow) and uses the name in that cell to insert a picture
in column H.

The value in column G shouldn't include the path or the extension. *This line
creates the path, filename and extension.

myPictName = myPath & myCell.Value & ".jpg"

If you already have ".jpg" in the cell, you can drop it off this line of code:
myPictName = myPath & myCell.Value





RemyMaza wrote:

I'm trying to insert pics based on values that appear in a cell. *I
have this code and I've got it to work by hardcoding values. *Since I
have like 500 variables, I'd like to steer clear of hardcoding. *What
I need help with is selecting the Column to look in and then finding
the correct value
I know this code doesn't work but it should provide direction to what
I'd like to happen.

* * Dim CellLoop As Range
* * Dim CellVal As String
* * CellLoop = Range("G:G")
* * CellVal = ActiveCell.FormulaR1C1

* * 'Don't Know how to get this to work
* * Select Case CellVal in CellLoop
* * * * Case 1
* * * * * * InsertPicture "C:\Users\mbramer\Desktop\R_RImages\1.jpg",
_
* * * * * * * * ActiveCell.Offset(0, -2), True, True
* * * * Case 2
* * * * * * InsertPicture "C:\Users\mbramer\Desktop\R_RImages\2.jpg",
_
* * * * * * * * ActiveCell.Offset(0, -2), True, True
* * * * Case Else
* * * * * * MsgBox ("Wrong Values")
* * * * End Select

Thanks for your help!
Regards,
Matt

--

Dave Peterson- Hide quoted text -

- Show quoted text -

This is what I've came up with but I don't get an error, I get 5 of
the same "1.jpg" in cell "E1". I think it may have something to do
with the Sub InserPicture but it's not my code and it's a bit over my
head. Thanks for your reply and anyones' input.

Private Sub cmdTest_Click()
Dim myPath As String
Dim CellVal As String
Dim myRng As Range
Dim myCell As Range

myPath = "C:\Users\mbramer\Desktop\R_RImages"
CellVal = ActiveCell.FormulaR1C1

With Worksheets("Sheet1")
Set myRng = .Range("G1", .Cells(.Rows.Count, "G").End(xlUp))

For Each myCell In myRng.Cells
Select Case CellVal
Case "Test"
InsertPicture myPath & "\" & "1.jpg", _
ActiveCell.Offset(0, -2), True, True
Case "Test2"
InsertPicture myPath & "\" & "2.jpg", _
ActiveCell.Offset(0, -2), True, True
Case "Test3"
InsertPicture myPath & "\" & "3.jpg", _
ActiveCell.Offset(0, -2), True, True
Case Else
MsgBox ("No Values")
End Select
Next myCell
End With
End Sub

Sub InsertPicture(PictureFileName As String, TargetCell As Range, _
CenterH As Boolean, CenterV As Boolean)
' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(ActiveSheet) < "Worksheet" Then Exit Sub
If Dir(PictureFileName) = "" Then Exit Sub
' import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
' determine positions
With TargetCell
t = .Top
l = .Left
If CenterH Then
w = .Offset(0, 1).Left - .Left
l = l + w / 2 - p.Width / 2
If l < 1 Then l = 1
End If
If CenterV Then
h = .Offset(1, 0).Top - .Top
t = t + h / 2 - p.Height / 2
If t < 1 Then t = 1
End If
End With
' position picture
With p
.Top = t
.Left = l
End With
Set p = Nothing
End Sub

I think it's more of this line causing the trouble:

InsertPicture myPath & "\" & "2.jpg", _
ActiveCell.Offset(0, -2), True, True

The activecell isn't changing in the new code.

I'd try:

InsertPicture myPath & "\" & "2.jpg", _
mycell.Offset(0, -2), True, True

You have a few lines like this to change.

RemyMaza wrote:

On May 5, 5:21 pm, Dave Peterson wrote:
Maybe...

Option Explicit
Sub testme()
Dim myPath As String
Dim myRng As Range
Dim myCell As Range
Dim TestStr As String
Dim myPict As Picture
Dim myPictName As String
Dim myRatio As Double

'change to the correct location of the picture files
myPath = "C:\Users\mbramer\Desktop\R_RImages"
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

With Worksheets("Sheet1")
.Pictures.Delete 'remove any existing pictures???
Set myRng = .Range("G1", .Cells(.Rows.Count, "G").End(xlUp))

For Each myCell In myRng.Cells
myPictName = myPath & myCell.Value & ".jpg"
TestStr = ""
On Error Resume Next
TestStr = Dir(myPictName)
On Error GoTo 0
If TestStr = "" Then
MsgBox "Pictu " & myPictName & " wasn't found"
Else
Set myPict = .Pictures.Insert(myPictName)
With myCell.Offset(0, 1)
myPict.ShapeRange.LockAspectRatio = msoFalse
myRatio = myPict.Width / myPict.Height
myPict.Top = .Top
myPict.Left = .Left
myPict.Height = .Height
myPict.Width = .Height * myRatio
myPict.Name = "Pict_" & .Address(0, 0)
myPict.ShapeRange.LockAspectRatio = msoTrue
End With
End If
Next myCell
End With
End Sub

=====
It looks in G1:G(lastusedrow) and uses the name in that cell to insert a picture
in column H.

The value in column G shouldn't include the path or the extension. This line
creates the path, filename and extension.

myPictName = myPath & myCell.Value & ".jpg"

If you already have ".jpg" in the cell, you can drop it off this line of code:
myPictName = myPath & myCell.Value





RemyMaza wrote:

I'm trying to insert pics based on values that appear in a cell. I
have this code and I've got it to work by hardcoding values. Since I
have like 500 variables, I'd like to steer clear of hardcoding. What
I need help with is selecting the Column to look in and then finding
the correct value
I know this code doesn't work but it should provide direction to what
I'd like to happen.

Dim CellLoop As Range
Dim CellVal As String
CellLoop = Range("G:G")
CellVal = ActiveCell.FormulaR1C1

'Don't Know how to get this to work
Select Case CellVal in CellLoop
Case 1
InsertPicture "C:\Users\mbramer\Desktop\R_RImages\1.jpg",
_
ActiveCell.Offset(0, -2), True, True
Case 2
InsertPicture "C:\Users\mbramer\Desktop\R_RImages\2.jpg",
_
ActiveCell.Offset(0, -2), True, True
Case Else
MsgBox ("Wrong Values")
End Select

Thanks for your help!
Regards,
Matt

--

Dave Peterson- Hide quoted text -

- Show quoted text -

This is what I've came up with but I don't get an error, I get 5 of
the same "1.jpg" in cell "E1". I think it may have something to do
with the Sub InserPicture but it's not my code and it's a bit over my
head. Thanks for your reply and anyones' input.

Private Sub cmdTest_Click()
Dim myPath As String
Dim CellVal As String
Dim myRng As Range
Dim myCell As Range

myPath = "C:\Users\mbramer\Desktop\R_RImages"
CellVal = ActiveCell.FormulaR1C1

With Worksheets("Sheet1")
Set myRng = .Range("G1", .Cells(.Rows.Count, "G").End(xlUp))

For Each myCell In myRng.Cells
Select Case CellVal
Case "Test"
InsertPicture myPath & "\" & "1.jpg", _
ActiveCell.Offset(0, -2), True, True
Case "Test2"
InsertPicture myPath & "\" & "2.jpg", _
ActiveCell.Offset(0, -2), True, True
Case "Test3"
InsertPicture myPath & "\" & "3.jpg", _
ActiveCell.Offset(0, -2), True, True
Case Else
MsgBox ("No Values")
End Select
Next myCell
End With
End Sub

Sub InsertPicture(PictureFileName As String, TargetCell As Range, _
CenterH As Boolean, CenterV As Boolean)
' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(ActiveSheet) < "Worksheet" Then Exit Sub
If Dir(PictureFileName) = "" Then Exit Sub
' import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
' determine positions
With TargetCell
t = .Top
l = .Left
If CenterH Then
w = .Offset(0, 1).Left - .Left
l = l + w / 2 - p.Width / 2
If l < 1 Then l = 1
End If
If CenterV Then
h = .Offset(1, 0).Top - .Top
t = t + h / 2 - p.Height / 2
If t < 1 Then t = 1
End If
End With
' position picture
With p
.Top = t
.Left = l
End With
Set p = Nothing
End Sub

--

Dave Peterson

On May 5, 9:24*pm, Dave Peterson wrote:
I think it's more of this line causing the trouble:

* * * * * * * * * * InsertPicture myPath & "\" & "2.jpg", _
* * * * * * * * * * * * ActiveCell.Offset(0, -2), True, True

The activecell isn't changing in the new code.

I'd try:

* * * * * * * * * * InsertPicture myPath & "\" & "2.jpg", _
* * * * * * * * * * * * mycell.Offset(0, -2), True, True

You have a few lines like this to change.





RemyMaza wrote:

On May 5, 5:21 pm, Dave Peterson wrote:
Maybe...

Option Explicit
Sub testme()
* * Dim myPath As String
* * Dim myRng As Range
* * Dim myCell As Range
* * Dim TestStr As String
* * Dim myPict As Picture
* * Dim myPictName As String
* * Dim myRatio As Double

* * 'change to the correct location of the picture files
* * myPath = "C:\Users\mbramer\Desktop\R_RImages"
* * If Right(myPath, 1) < "\" Then
* * * * myPath = myPath & "\"
* * End If

* * With Worksheets("Sheet1")
* * * * .Pictures.Delete 'remove any existing pictures???
* * * * Set myRng = .Range("G1", .Cells(.Rows.Count, "G").End(xlUp))

* * * * For Each myCell In myRng.Cells
* * * * * * myPictName = myPath & myCell.Value & ".jpg"
* * * * * * TestStr = ""
* * * * * * On Error Resume Next
* * * * * * TestStr = Dir(myPictName)
* * * * * * On Error GoTo 0
* * * * * * If TestStr = "" Then
* * * * * * * * MsgBox "Pictu " & myPictName & " wasn't found"
* * * * * * Else
* * * * * * * * Set myPict = .Pictures.Insert(myPictName)
* * * * * * * * With myCell.Offset(0, 1)
* * * * * * * * * * myPict.ShapeRange.LockAspectRatio = msoFalse
* * * * * * * * * * myRatio = myPict.Width / myPict.Height
* * * * * * * * * * myPict.Top = .Top
* * * * * * * * * * myPict.Left = .Left
* * * * * * * * * * myPict.Height = .Height
* * * * * * * * * * myPict.Width = .Height * myRatio
* * * * * * * * * * myPict.Name = "Pict_" & .Address(0, 0)
* * * * * * * * * * myPict.ShapeRange.LockAspectRatio = msoTrue
* * * * * * * * End With
* * * * * * End If
* * * * Next myCell
* * End With
End Sub

=====
It looks in G1:G(lastusedrow) and uses the name in that cell to insert a picture
in column H.

The value in column G shouldn't include the path or the extension. *This line
creates the path, filename and extension.

myPictName = myPath & myCell.Value & ".jpg"

If you already have ".jpg" in the cell, you can drop it off this line of code:
myPictName = myPath & myCell.Value

RemyMaza wrote:

I'm trying to insert pics based on values that appear in a cell. *I
have this code and I've got it to work by hardcoding values. *Since I
have like 500 variables, I'd like to steer clear of hardcoding. *What
I need help with is selecting the Column to look in and then finding
the correct value
I know this code doesn't work but it should provide direction to what
I'd like to happen.

* * Dim CellLoop As Range
* * Dim CellVal As String
* * CellLoop = Range("G:G")
* * CellVal = ActiveCell.FormulaR1C1

* * 'Don't Know how to get this to work
* * Select Case CellVal in CellLoop
* * * * Case 1
* * * * * * InsertPicture "C:\Users\mbramer\Desktop\R_RImages\1.jpg",
_
* * * * * * * * ActiveCell.Offset(0, -2), True, True
* * * * Case 2
* * * * * * InsertPicture "C:\Users\mbramer\Desktop\R_RImages\2.jpg",
_
* * * * * * * * ActiveCell.Offset(0, -2), True, True
* * * * Case Else
* * * * * * MsgBox ("Wrong Values")
* * * * End Select

Thanks for your help!
Regards,
Matt

--

Dave Peterson- Hide quoted text -

- Show quoted text -

This is what I've came up with but I don't get an error, I get 5 of
the same "1.jpg" in cell "E1". *I think it may have something to do
with the Sub InserPicture but it's not my code and it's a bit over my
head. *Thanks for your reply and anyones' input.

Private Sub cmdTest_Click()
* * Dim myPath As String
* * Dim CellVal As String
* * Dim myRng As Range
* * Dim myCell As Range

* * myPath = "C:\Users\mbramer\Desktop\R_RImages"
* * CellVal = ActiveCell.FormulaR1C1

* * With Worksheets("Sheet1")
* * * * Set myRng = .Range("G1", .Cells(.Rows.Count, "G").End(xlUp))

* * * * For Each myCell In myRng.Cells
* * * * * * Select Case CellVal
* * * * * * Case "Test"
* * * * * * * * * * InsertPicture myPath & "\" & "1.jpg", _
* * * * * * * * * * * * ActiveCell.Offset(0, -2), True, True
* * * * * * Case "Test2"
* * * * * * * * * * InsertPicture myPath & "\" & "2.jpg", _
* * * * * * * * * * * * ActiveCell.Offset(0, -2), True, True
* * * * * * Case "Test3"
* * * * * * * * * * InsertPicture myPath & "\" & "3.jpg", _
* * * * * * * * * * * * ActiveCell.Offset(0, -2), True, True
* * * * * * Case Else
* * * * * * * * MsgBox ("No Values")
* * * * * * End Select
* * * * Next myCell
* * End With
End Sub

Sub InsertPicture(PictureFileName As String, TargetCell As Range, _
* * CenterH As Boolean, CenterV As Boolean)
' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
Dim p As Object, t As Double, l As Double, w As Double, h As Double
* * If TypeName(ActiveSheet) < "Worksheet" Then Exit Sub
* * If Dir(PictureFileName) = "" Then Exit Sub
* * ' import picture
* * Set p = ActiveSheet.Pictures.Insert(PictureFileName)
* * ' determine positions
* * With TargetCell
* * * * t = .Top
* * * * l = .Left
* * * * If CenterH Then
* * * * * * w = .Offset(0, 1).Left - .Left
* * * * * * l = l + w / 2 - p.Width / 2
* * * * * * If l < 1 Then l = 1
* * * * End If
* * * * If CenterV Then
* * * * * * h = .Offset(1, 0).Top - .Top
* * * * * * t = t + h / 2 - p.Height / 2
* * * * * * If t < 1 Then t = 1
* * * * End If
* * End With
* * ' position picture
* * With p
* * * * .Top = t
* * * * .Left = l
* * End With
* * Set p = Nothing
End Sub

--

Dave Peterson- Hide quoted text -

- Show quoted text -

We are getting real close. I've changed the code with your input.
Now I get the same pic for each line that has a value. I put Test,
Test2, Test3, and the word Input in Column G. I get pic 1.jpg for
every line. I deleted the pic thinking that there were multiple icons
there but this is the only one being inserted. I changed this line:

CellVal = myCell.FormulaR1C1

But that gave me errors so I changed it back to:

CellVal = ActiveCell.FormulaR1C1

So SO SO close... Thanks so much for your help. I can't think of why
this won't work, but then again, I don't really program in Excel too
often.

Regards,
Matt

On May 5, 9:24*pm, Dave Peterson wrote:
I think it's more of this line causing the trouble:

* * * * * * * * * * InsertPicture myPath & "\" & "2.jpg", _
* * * * * * * * * * * * ActiveCell.Offset(0, -2), True, True

The activecell isn't changing in the new code.

I'd try:

* * * * * * * * * * InsertPicture myPath & "\" & "2.jpg", _
* * * * * * * * * * * * mycell.Offset(0, -2), True, True

You have a few lines like this to change.





RemyMaza wrote:

On May 5, 5:21 pm, Dave Peterson wrote:
Maybe...

Option Explicit
Sub testme()
* * Dim myPath As String
* * Dim myRng As Range
* * Dim myCell As Range
* * Dim TestStr As String
* * Dim myPict As Picture
* * Dim myPictName As String
* * Dim myRatio As Double

* * 'change to the correct location of the picture files
* * myPath = "C:\Users\mbramer\Desktop\R_RImages"
* * If Right(myPath, 1) < "\" Then
* * * * myPath = myPath & "\"
* * End If

* * With Worksheets("Sheet1")
* * * * .Pictures.Delete 'remove any existing pictures???
* * * * Set myRng = .Range("G1", .Cells(.Rows.Count, "G").End(xlUp))

* * * * For Each myCell In myRng.Cells
* * * * * * myPictName = myPath & myCell.Value & ".jpg"
* * * * * * TestStr = ""
* * * * * * On Error Resume Next
* * * * * * TestStr = Dir(myPictName)
* * * * * * On Error GoTo 0
* * * * * * If TestStr = "" Then
* * * * * * * * MsgBox "Pictu " & myPictName & " wasn't found"
* * * * * * Else
* * * * * * * * Set myPict = .Pictures.Insert(myPictName)
* * * * * * * * With myCell.Offset(0, 1)
* * * * * * * * * * myPict.ShapeRange.LockAspectRatio = msoFalse
* * * * * * * * * * myRatio = myPict.Width / myPict.Height
* * * * * * * * * * myPict.Top = .Top
* * * * * * * * * * myPict.Left = .Left
* * * * * * * * * * myPict.Height = .Height
* * * * * * * * * * myPict.Width = .Height * myRatio
* * * * * * * * * * myPict.Name = "Pict_" & .Address(0, 0)
* * * * * * * * * * myPict.ShapeRange.LockAspectRatio = msoTrue
* * * * * * * * End With
* * * * * * End If
* * * * Next myCell
* * End With
End Sub

=====
It looks in G1:G(lastusedrow) and uses the name in that cell to insert a picture
in column H.

The value in column G shouldn't include the path or the extension. *This line
creates the path, filename and extension.

myPictName = myPath & myCell.Value & ".jpg"

If you already have ".jpg" in the cell, you can drop it off this line of code:
myPictName = myPath & myCell.Value

RemyMaza wrote:

I'm trying to insert pics based on values that appear in a cell. *I
have this code and I've got it to work by hardcoding values. *Since I
have like 500 variables, I'd like to steer clear of hardcoding. *What
I need help with is selecting the Column to look in and then finding
the correct value
I know this code doesn't work but it should provide direction to what
I'd like to happen.

* * Dim CellLoop As Range
* * Dim CellVal As String
* * CellLoop = Range("G:G")
* * CellVal = ActiveCell.FormulaR1C1

* * 'Don't Know how to get this to work
* * Select Case CellVal in CellLoop
* * * * Case 1
* * * * * * InsertPicture "C:\Users\mbramer\Desktop\R_RImages\1.jpg",
_
* * * * * * * * ActiveCell.Offset(0, -2), True, True
* * * * Case 2
* * * * * * InsertPicture "C:\Users\mbramer\Desktop\R_RImages\2.jpg",
_
* * * * * * * * ActiveCell.Offset(0, -2), True, True
* * * * Case Else
* * * * * * MsgBox ("Wrong Values")
* * * * End Select

Thanks for your help!
Regards,
Matt

--

Dave Peterson- Hide quoted text -

- Show quoted text -

This is what I've came up with but I don't get an error, I get 5 of
the same "1.jpg" in cell "E1". *I think it may have something to do
with the Sub InserPicture but it's not my code and it's a bit over my
head. *Thanks for your reply and anyones' input.

Private Sub cmdTest_Click()
* * Dim myPath As String
* * Dim CellVal As String
* * Dim myRng As Range
* * Dim myCell As Range

* * myPath = "C:\Users\mbramer\Desktop\R_RImages"
* * CellVal = ActiveCell.FormulaR1C1

* * With Worksheets("Sheet1")
* * * * Set myRng = .Range("G1", .Cells(.Rows.Count, "G").End(xlUp))

* * * * For Each myCell In myRng.Cells
* * * * * * Select Case CellVal
* * * * * * Case "Test"
* * * * * * * * * * InsertPicture myPath & "\" & "1.jpg", _
* * * * * * * * * * * * ActiveCell.Offset(0, -2), True, True
* * * * * * Case "Test2"
* * * * * * * * * * InsertPicture myPath & "\" & "2.jpg", _
* * * * * * * * * * * * ActiveCell.Offset(0, -2), True, True
* * * * * * Case "Test3"
* * * * * * * * * * InsertPicture myPath & "\" & "3.jpg", _
* * * * * * * * * * * * ActiveCell.Offset(0, -2), True, True
* * * * * * Case Else
* * * * * * * * MsgBox ("No Values")
* * * * * * End Select
* * * * Next myCell
* * End With
End Sub

Sub InsertPicture(PictureFileName As String, TargetCell As Range, _
* * CenterH As Boolean, CenterV As Boolean)
' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
Dim p As Object, t As Double, l As Double, w As Double, h As Double
* * If TypeName(ActiveSheet) < "Worksheet" Then Exit Sub
* * If Dir(PictureFileName) = "" Then Exit Sub
* * ' import picture
* * Set p = ActiveSheet.Pictures.Insert(PictureFileName)
* * ' determine positions
* * With TargetCell
* * * * t = .Top
* * * * l = .Left
* * * * If CenterH Then
* * * * * * w = .Offset(0, 1).Left - .Left
* * * * * * l = l + w / 2 - p.Width / 2
* * * * * * If l < 1 Then l = 1
* * * * End If
* * * * If CenterV Then
* * * * * * h = .Offset(1, 0).Top - .Top
* * * * * * t = t + h / 2 - p.Height / 2
* * * * * * If t < 1 Then t = 1
* * * * End If
* * End With
* * ' position picture
* * With p
* * * * .Top = t
* * * * .Left = l
* * End With
* * Set p = Nothing
End Sub

--

Dave Peterson- Hide quoted text -

- Show quoted text -

I just tried IF statements and got the same result as I did with the
Case statements. Seems like my variable isn't being looked at for
some reason. Here's the code I tried:

If CellVal = "Test" Then
InsertPicture myPath & "\" & "2.jpg", _
myCell.Offset(0, -2), True, True
ElseIf CellVal = "Test2" Then
InsertPicture myPath & "\" & "4.jpg", _
myCell.Offset(0, -2), True, True
ElseIf CellVal = "Test3" Then
InsertPicture myPath & "\" & "6.jpg", _
myCell.Offset(0, -2), True, True

Same result though :-( Thanks again for your help Dave. You keep
earning your 5 stars here!

Since you're cycling through a bunch of cells, you don't want to use something
like:

CellVal = ActiveCell.FormulaR1C1

This will never change. Even if you change it to mycell.formular1c1, then you'd
have to move it into the loop so that it knows what mycell is and so that it
changes for each cell in that loop.

I dropped the line and variable and made a couple of changes to both the
cmdTest_click subroutine and to the insertpicture subroutine.


Option Explicit
Private Sub cmdTest_Click()
Dim myPath As String
Dim myRng As Range
Dim myCell As Range

myPath = "C:\Users\mbramer\Desktop\R_RImages"

With Worksheets("Sheet1")
Set myRng = .Range("G1", .Cells(.Rows.Count, "G").End(xlUp))

For Each myCell In myRng.Cells
Select Case LCase(myCell.Value)
Case LCase("Test")
InsertPicture myPath & "\" & "1.jpg", _
myCell.Offset(0, -2), True, True
Case LCase("Test2")
InsertPicture myPath & "\" & "2.jpg", _
myCell.Offset(0, -2), True, True
Case LCase("Test3")
InsertPicture myPath & "\" & "3.jpg", _
myCell.Offset(0, -2), True, True
Case Else
MsgBox "No Values in: " & myCell.Address(0, 0)
End Select
Next myCell
End With
End Sub

Sub InsertPicture(PictureFileName As String, TargetCell As Range, _
CenterH As Boolean, CenterV As Boolean)
' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(TargetCell.Parent) < "Worksheet" Then Exit Sub
If Dir(PictureFileName) = "" Then Exit Sub
' import picture
Set p = TargetCell.Parent.Pictures.Insert(PictureFileName)
' determine positions
With TargetCell
t = .Top
l = .Left
If CenterH Then
w = .Offset(0, 1).Left - .Left
l = l + w / 2 - p.Width / 2
If l < 1 Then l = 1
End If
If CenterV Then
h = .Offset(1, 0).Top - .Top
t = t + h / 2 - p.Height / 2
If t < 1 Then t = 1
End If
End With
' position picture
With p
.Top = t
.Left = l
End With
Set p = Nothing
End Sub



RemyMaza wrote:

On May 5, 9:24 pm, Dave Peterson wrote:
I think it's more of this line causing the trouble:

InsertPicture myPath & "\" & "2.jpg", _
ActiveCell.Offset(0, -2), True, True

The activecell isn't changing in the new code.

I'd try:

InsertPicture myPath & "\" & "2.jpg", _
mycell.Offset(0, -2), True, True

You have a few lines like this to change.





RemyMaza wrote:

On May 5, 5:21 pm, Dave Peterson wrote:
Maybe...

Option Explicit
Sub testme()
Dim myPath As String
Dim myRng As Range
Dim myCell As Range
Dim TestStr As String
Dim myPict As Picture
Dim myPictName As String
Dim myRatio As Double

'change to the correct location of the picture files
myPath = "C:\Users\mbramer\Desktop\R_RImages"
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

With Worksheets("Sheet1")
.Pictures.Delete 'remove any existing pictures???
Set myRng = .Range("G1", .Cells(.Rows.Count, "G").End(xlUp))

For Each myCell In myRng.Cells
myPictName = myPath & myCell.Value & ".jpg"
TestStr = ""
On Error Resume Next
TestStr = Dir(myPictName)
On Error GoTo 0
If TestStr = "" Then
MsgBox "Pictu " & myPictName & " wasn't found"
Else
Set myPict = .Pictures.Insert(myPictName)
With myCell.Offset(0, 1)
myPict.ShapeRange.LockAspectRatio = msoFalse
myRatio = myPict.Width / myPict.Height
myPict.Top = .Top
myPict.Left = .Left
myPict.Height = .Height
myPict.Width = .Height * myRatio
myPict.Name = "Pict_" & .Address(0, 0)
myPict.ShapeRange.LockAspectRatio = msoTrue
End With
End If
Next myCell
End With
End Sub

=====
It looks in G1:G(lastusedrow) and uses the name in that cell to insert a picture
in column H.

The value in column G shouldn't include the path or the extension. This line
creates the path, filename and extension.

myPictName = myPath & myCell.Value & ".jpg"

If you already have ".jpg" in the cell, you can drop it off this line of code:
myPictName = myPath & myCell.Value

RemyMaza wrote:

I'm trying to insert pics based on values that appear in a cell. I
have this code and I've got it to work by hardcoding values. Since I
have like 500 variables, I'd like to steer clear of hardcoding. What
I need help with is selecting the Column to look in and then finding
the correct value
I know this code doesn't work but it should provide direction to what
I'd like to happen.

Dim CellLoop As Range
Dim CellVal As String
CellLoop = Range("G:G")
CellVal = ActiveCell.FormulaR1C1

'Don't Know how to get this to work
Select Case CellVal in CellLoop
Case 1
InsertPicture "C:\Users\mbramer\Desktop\R_RImages\1.jpg",
_
ActiveCell.Offset(0, -2), True, True
Case 2
InsertPicture "C:\Users\mbramer\Desktop\R_RImages\2.jpg",
_
ActiveCell.Offset(0, -2), True, True
Case Else
MsgBox ("Wrong Values")
End Select

Thanks for your help!
Regards,
Matt

--

Dave Peterson- Hide quoted text -

- Show quoted text -

This is what I've came up with but I don't get an error, I get 5 of
the same "1.jpg" in cell "E1". I think it may have something to do
with the Sub InserPicture but it's not my code and it's a bit over my
head. Thanks for your reply and anyones' input.

Private Sub cmdTest_Click()
Dim myPath As String
Dim CellVal As String
Dim myRng As Range
Dim myCell As Range

myPath = "C:\Users\mbramer\Desktop\R_RImages"
CellVal = ActiveCell.FormulaR1C1

With Worksheets("Sheet1")
Set myRng = .Range("G1", .Cells(.Rows.Count, "G").End(xlUp))

For Each myCell In myRng.Cells
Select Case CellVal
Case "Test"
InsertPicture myPath & "\" & "1.jpg", _
ActiveCell.Offset(0, -2), True, True
Case "Test2"
InsertPicture myPath & "\" & "2.jpg", _
ActiveCell.Offset(0, -2), True, True
Case "Test3"
InsertPicture myPath & "\" & "3.jpg", _
ActiveCell.Offset(0, -2), True, True
Case Else
MsgBox ("No Values")
End Select
Next myCell
End With
End Sub

Sub InsertPicture(PictureFileName As String, TargetCell As Range, _
CenterH As Boolean, CenterV As Boolean)
' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(ActiveSheet) < "Worksheet" Then Exit Sub
If Dir(PictureFileName) = "" Then Exit Sub
' import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
' determine positions
With TargetCell
t = .Top
l = .Left
If CenterH Then
w = .Offset(0, 1).Left - .Left
l = l + w / 2 - p.Width / 2
If l < 1 Then l = 1
End If
If CenterV Then
h = .Offset(1, 0).Top - .Top
t = t + h / 2 - p.Height / 2
If t < 1 Then t = 1
End If
End With
' position picture
With p
.Top = t
.Left = l
End With
Set p = Nothing
End Sub

--

Dave Peterson- Hide quoted text -

- Show quoted text -

We are getting real close. I've changed the code with your input.
Now I get the same pic for each line that has a value. I put Test,
Test2, Test3, and the word Input in Column G. I get pic 1.jpg for
every line. I deleted the pic thinking that there were multiple icons
there but this is the only one being inserted. I changed this line:

CellVal = myCell.FormulaR1C1

But that gave me errors so I changed it back to:

CellVal = ActiveCell.FormulaR1C1

So SO SO close... Thanks so much for your help. I can't think of why
this won't work, but then again, I don't really program in Excel too
often.

Regards,
Matt

--

Dave Peterson

On May 6, 7:18*am, Dave Peterson wrote:
Since you're cycling through a bunch of cells, you don't want to use something
like:

CellVal = ActiveCell.FormulaR1C1

This will never change. *Even if you change it to mycell.formular1c1, then you'd
have to move it into the loop so that it knows what mycell is and so that it
changes for each cell in that loop.

I dropped the line and variable and made a couple of changes to both the
cmdTest_click subroutine and to the insertpicture subroutine.

Option Explicit
Private Sub cmdTest_Click()
* * Dim myPath As String
* * Dim myRng As Range
* * Dim myCell As Range

* * myPath = "C:\Users\mbramer\Desktop\R_RImages"

* * With Worksheets("Sheet1")
* * * * Set myRng = .Range("G1", .Cells(.Rows.Count, "G").End(xlUp))

* * * * For Each myCell In myRng.Cells
* * * * * * Select Case LCase(myCell.Value)
* * * * * * * * Case LCase("Test")
* * * * * * * * * * * * InsertPicture myPath & "\" & "1.jpg", _
* * * * * * * * * * * * * * myCell.Offset(0, -2), True, True
* * * * * * * * Case LCase("Test2")
* * * * * * * * * * * * InsertPicture myPath & "\" & "2.jpg", _
* * * * * * * * * * * * * * myCell.Offset(0, -2), True, True
* * * * * * * * Case LCase("Test3")
* * * * * * * * * * * * InsertPicture myPath & "\" & "3.jpg", _
* * * * * * * * * * * * * * myCell.Offset(0, -2), True, True
* * * * * * * * Case Else
* * * * * * * * * * MsgBox "No Values in: " & myCell.Address(0, 0)
* * * * * * End Select
* * * * Next myCell
* * End With
End Sub

Sub InsertPicture(PictureFileName As String, TargetCell As Range, _
* * CenterH As Boolean, CenterV As Boolean)
' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
Dim p As Object, t As Double, l As Double, w As Double, h As Double
* * If TypeName(TargetCell.Parent) < "Worksheet" Then Exit Sub
* * If Dir(PictureFileName) = "" Then Exit Sub
* * ' import picture
* * Set p = TargetCell.Parent.Pictures.Insert(PictureFileName)
* * ' determine positions
* * With TargetCell
* * * * t = .Top
* * * * l = .Left
* * * * If CenterH Then
* * * * * * w = .Offset(0, 1).Left - .Left
* * * * * * l = l + w / 2 - p.Width / 2
* * * * * * If l < 1 Then l = 1
* * * * End If
* * * * If CenterV Then
* * * * * * h = .Offset(1, 0).Top - .Top
* * * * * * t = t + h / 2 - p.Height / 2
* * * * * * If t < 1 Then t = 1
* * * * End If
* * End With
* * ' position picture
* * With p
* * * * .Top = t
* * * * .Left = l
* * End With
* * Set p = Nothing
End Sub



RemyMaza wrote:

On May 5, 9:24 pm, Dave Peterson wrote:
I think it's more of this line causing the trouble:

* * * * * * * * * * InsertPicture myPath & "\" & "2.jpg", _
* * * * * * * * * * * * ActiveCell.Offset(0, -2), True, True

The activecell isn't changing in the new code.

I'd try:

* * * * * * * * * * InsertPicture myPath & "\" & "2.jpg", _
* * * * * * * * * * * * mycell.Offset(0, -2), True, True

You have a few lines like this to change.

RemyMaza wrote:

On May 5, 5:21 pm, Dave Peterson wrote:
Maybe...

Option Explicit
Sub testme()
* * Dim myPath As String
* * Dim myRng As Range
* * Dim myCell As Range
* * Dim TestStr As String
* * Dim myPict As Picture
* * Dim myPictName As String
* * Dim myRatio As Double

* * 'change to the correct location of the picture files
* * myPath = "C:\Users\mbramer\Desktop\R_RImages"
* * If Right(myPath, 1) < "\" Then
* * * * myPath = myPath & "\"
* * End If

* * With Worksheets("Sheet1")
* * * * .Pictures.Delete 'remove any existing pictures???
* * * * Set myRng = .Range("G1", .Cells(.Rows.Count, "G").End(xlUp))

* * * * For Each myCell In myRng.Cells
* * * * * * myPictName = myPath & myCell.Value & ".jpg"
* * * * * * TestStr = ""
* * * * * * On Error Resume Next
* * * * * * TestStr = Dir(myPictName)
* * * * * * On Error GoTo 0
* * * * * * If TestStr = "" Then
* * * * * * * * MsgBox "Pictu " & myPictName & " wasn't found"
* * * * * * Else
* * * * * * * * Set myPict = .Pictures.Insert(myPictName)
* * * * * * * * With myCell.Offset(0, 1)
* * * * * * * * * * myPict.ShapeRange.LockAspectRatio = msoFalse
* * * * * * * * * * myRatio = myPict.Width / myPict.Height
* * * * * * * * * * myPict.Top = .Top
* * * * * * * * * * myPict.Left = .Left
* * * * * * * * * * myPict.Height = .Height
* * * * * * * * * * myPict.Width = .Height * myRatio
* * * * * * * * * * myPict.Name = "Pict_" & ..Address(0, 0)
* * * * * * * * * * myPict.ShapeRange.LockAspectRatio = msoTrue
* * * * * * * * End With
* * * * * * End If
* * * * Next myCell
* * End With
End Sub

=====
It looks in G1:G(lastusedrow) and uses the name in that cell to insert a picture
in column H.

The value in column G shouldn't include the path or the extension. *This line
creates the path, filename and extension.

myPictName = myPath & myCell.Value & ".jpg"

If you already have ".jpg" in the cell, you can drop it off this line of code:
myPictName = myPath & myCell.Value

RemyMaza wrote:

I'm trying to insert pics based on values that appear in a cell. *I
have this code and I've got it to work by hardcoding values. *Since I
have like 500 variables, I'd like to steer clear of hardcoding. *What
I need help with is selecting the Column to look in and then finding
the correct value
I know this code doesn't work but it should provide direction to what
I'd like to happen.

* * Dim CellLoop As Range
* * Dim CellVal As String
* * CellLoop = Range("G:G")
* * CellVal = ActiveCell.FormulaR1C1

* * 'Don't Know how to get this to work
* * Select Case CellVal in CellLoop
* * * * Case 1
* * * * * * InsertPicture "C:\Users\mbramer\Desktop\R_RImages\1.jpg",
_
* * * * * * * * ActiveCell.Offset(0, -2), True, True
* * * * Case 2
* * * * * * InsertPicture "C:\Users\mbramer\Desktop\R_RImages\2.jpg",
_
* * * * * * * * ActiveCell.Offset(0, -2), True, True
* * * * Case Else
* * * * * * MsgBox ("Wrong Values")
* * * * End Select

Thanks for your help!
Regards,
Matt

--

Dave Peterson- Hide quoted text -

- Show quoted text -

This is what I've came up with but I don't get an error, I get 5 of
the same "1.jpg" in cell "E1". *I think it may have something to do
with the Sub InserPicture but it's not my code and it's a bit over my
head. *Thanks for your reply and anyones' input.

Private Sub cmdTest_Click()
* * Dim myPath As String
* * Dim CellVal As String
* * Dim myRng As Range
* * Dim myCell As Range

* * myPath = "C:\Users\mbramer\Desktop\R_RImages"
* * CellVal = ActiveCell.FormulaR1C1

* * With Worksheets("Sheet1")
* * * * Set myRng = .Range("G1", .Cells(.Rows.Count, "G").End(xlUp))

* * * * For Each myCell In myRng.Cells
* * * * * * Select Case CellVal
* * * * * * Case "Test"
* * * * * * * * * * InsertPicture myPath & "\" & "1.jpg", _
* * * * * * * * * * * * ActiveCell.Offset(0, -2), True, True
* * * * * * Case "Test2"
* * * * * * * * * * InsertPicture myPath & "\" & "2.jpg", _
* * * * * * * * * * * * ActiveCell.Offset(0, -2), True, True
* * * * * * Case "Test3"
* * * * * * * * * * InsertPicture myPath & "\" & "3.jpg", _
* * * * * * * * * * * * ActiveCell.Offset(0, -2), True, True
* * * * * * Case Else
* * * * * * * * MsgBox ("No Values")
* * * * * * End Select
* * * * Next myCell
* * End With
End Sub

Sub InsertPicture(PictureFileName As String, TargetCell As Range, _
* * CenterH As Boolean, CenterV As Boolean)
' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
Dim p As Object, t As Double, l As Double, w As Double, h As Double
* * If TypeName(ActiveSheet) < "Worksheet" Then Exit Sub
* * If Dir(PictureFileName) = "" Then Exit Sub
* * ' import picture
* * Set p = ActiveSheet.Pictures.Insert(PictureFileName)
* * ' determine positions
* * With TargetCell
* * * * t = .Top
* * * * l = .Left
* * * * If CenterH Then
* * * * * * w = .Offset(0, 1).Left - .Left
* * * * * * l = l + w / 2 - p.Width / 2
* * * * * * If l < 1 Then l = 1
* * * * End If
* * * * If CenterV Then
* * * * * * h = .Offset(1, 0).Top - .Top
* * * * * * t = t + h / 2 - p.Height / 2
* * * * * * If t < 1 Then t = 1
* * * * End If
* * End With
* * ' position picture
* * With p
* * * * .Top = t
* * * * .Left = l
* * End With
* * Set p = Nothing
End Sub

--

Dave Peterson- Hide quoted text -

- Show quoted text -

We are getting real close. *I've changed the code with your input.
Now I get the same pic for each line that has a value. *I put Test,
Test2, Test3, and the word Input in Column G. *I get pic 1.jpg for
every line. *I deleted the pic thinking that there were multiple icons
there but this is the only one being inserted. *I changed this line:

CellVal = myCell.FormulaR1C1

But that gave me errors so I changed it back to:

CellVal = ActiveCell.FormulaR1C1

So SO SO close... Thanks so much for your help. *I can't think of

...

read more »- Hide quoted text -

- Show quoted text -

You are a genius and have solved the riddle. Another quick question,
if you don't mind:

How can I use this code to look within a formula and not value. Would
I change:

Select Case LCase(myCell.Value)
to
Select Case LCase(myCell.FormulaR1C1)


Many Thanks,
Matt

On May 6, 8:29*am, RemyMaza wrote:
On May 6, 7:18*am, Dave Peterson wrote:

Since you're cycling through a bunch of cells, you don't want to use something
like:

CellVal = ActiveCell.FormulaR1C1

This will never change. *Even if you change it to mycell.formular1c1, then you'd
have to move it into the loop so that it knows what mycell is and so that it
changes for each cell in that loop.

I dropped the line and variable and made a couple of changes to both the
cmdTest_click subroutine and to the insertpicture subroutine.

Option Explicit
Private Sub cmdTest_Click()
* * Dim myPath As String
* * Dim myRng As Range
* * Dim myCell As Range

* * myPath = "C:\Users\mbramer\Desktop\R_RImages"

* * With Worksheets("Sheet1")
* * * * Set myRng = .Range("G1", .Cells(.Rows.Count, "G").End(xlUp))

* * * * For Each myCell In myRng.Cells
* * * * * * Select Case LCase(myCell.Value)
* * * * * * * * Case LCase("Test")
* * * * * * * * * * * * InsertPicture myPath & "\" & "1.jpg", _
* * * * * * * * * * * * * * myCell.Offset(0, -2), True, True
* * * * * * * * Case LCase("Test2")
* * * * * * * * * * * * InsertPicture myPath & "\" & "2.jpg", _
* * * * * * * * * * * * * * myCell.Offset(0, -2), True, True
* * * * * * * * Case LCase("Test3")
* * * * * * * * * * * * InsertPicture myPath & "\" & "3.jpg", _
* * * * * * * * * * * * * * myCell.Offset(0, -2), True, True
* * * * * * * * Case Else
* * * * * * * * * * MsgBox "No Values in: " & myCell..Address(0, 0)
* * * * * * End Select
* * * * Next myCell
* * End With
End Sub

Sub InsertPicture(PictureFileName As String, TargetCell As Range, _
* * CenterH As Boolean, CenterV As Boolean)
' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
Dim p As Object, t As Double, l As Double, w As Double, h As Double
* * If TypeName(TargetCell.Parent) < "Worksheet" Then Exit Sub
* * If Dir(PictureFileName) = "" Then Exit Sub
* * ' import picture
* * Set p = TargetCell.Parent.Pictures.Insert(PictureFileName)
* * ' determine positions
* * With TargetCell
* * * * t = .Top
* * * * l = .Left
* * * * If CenterH Then
* * * * * * w = .Offset(0, 1).Left - .Left
* * * * * * l = l + w / 2 - p.Width / 2
* * * * * * If l < 1 Then l = 1
* * * * End If
* * * * If CenterV Then
* * * * * * h = .Offset(1, 0).Top - .Top
* * * * * * t = t + h / 2 - p.Height / 2
* * * * * * If t < 1 Then t = 1
* * * * End If
* * End With
* * ' position picture
* * With p
* * * * .Top = t
* * * * .Left = l
* * End With
* * Set p = Nothing
End Sub

RemyMaza wrote:

On May 5, 9:24 pm, Dave Peterson wrote:
I think it's more of this line causing the trouble:

* * * * * * * * * * InsertPicture myPath & "\" & "2.jpg", _
* * * * * * * * * * * * ActiveCell.Offset(0, -2), True, True

The activecell isn't changing in the new code.

I'd try:

* * * * * * * * * * InsertPicture myPath & "\" & "2.jpg", _
* * * * * * * * * * * * mycell.Offset(0, -2), True, True

You have a few lines like this to change.

RemyMaza wrote:

On May 5, 5:21 pm, Dave Peterson wrote:
Maybe...

Option Explicit
Sub testme()
* * Dim myPath As String
* * Dim myRng As Range
* * Dim myCell As Range
* * Dim TestStr As String
* * Dim myPict As Picture
* * Dim myPictName As String
* * Dim myRatio As Double

* * 'change to the correct location of the picture files
* * myPath = "C:\Users\mbramer\Desktop\R_RImages"
* * If Right(myPath, 1) < "\" Then
* * * * myPath = myPath & "\"
* * End If

* * With Worksheets("Sheet1")
* * * * .Pictures.Delete 'remove any existing pictures???
* * * * Set myRng = .Range("G1", .Cells(.Rows.Count, "G").End(xlUp))

* * * * For Each myCell In myRng.Cells
* * * * * * myPictName = myPath & myCell.Value & "..jpg"
* * * * * * TestStr = ""
* * * * * * On Error Resume Next
* * * * * * TestStr = Dir(myPictName)
* * * * * * On Error GoTo 0
* * * * * * If TestStr = "" Then
* * * * * * * * MsgBox "Pictu " & myPictName & " wasn't found"
* * * * * * Else
* * * * * * * * Set myPict = .Pictures.Insert(myPictName)
* * * * * * * * With myCell.Offset(0, 1)
* * * * * * * * * * myPict.ShapeRange.LockAspectRatio = msoFalse
* * * * * * * * * * myRatio = myPict.Width / myPict.Height
* * * * * * * * * * myPict.Top = .Top
* * * * * * * * * * myPict.Left = .Left
* * * * * * * * * * myPict.Height = .Height
* * * * * * * * * * myPict.Width = .Height * myRatio
* * * * * * * * * * myPict.Name = "Pict_" & .Address(0, 0)
* * * * * * * * * * myPict.ShapeRange.LockAspectRatio = msoTrue
* * * * * * * * End With
* * * * * * End If
* * * * Next myCell
* * End With
End Sub

=====
It looks in G1:G(lastusedrow) and uses the name in that cell to insert a picture
in column H.

The value in column G shouldn't include the path or the extension. *This line
creates the path, filename and extension.

myPictName = myPath & myCell.Value & ".jpg"

If you already have ".jpg" in the cell, you can drop it off this line of code:
myPictName = myPath & myCell.Value

RemyMaza wrote:

I'm trying to insert pics based on values that appear in a cell. *I
have this code and I've got it to work by hardcoding values. *Since I
have like 500 variables, I'd like to steer clear of hardcoding.. *What
I need help with is selecting the Column to look in and then finding
the correct value
I know this code doesn't work but it should provide direction to what
I'd like to happen.

* * Dim CellLoop As Range
* * Dim CellVal As String
* * CellLoop = Range("G:G")
* * CellVal = ActiveCell.FormulaR1C1

* * 'Don't Know how to get this to work
* * Select Case CellVal in CellLoop
* * * * Case 1
* * * * * * InsertPicture "C:\Users\mbramer\Desktop\R_RImages\1.jpg",
_
* * * * * * * * ActiveCell.Offset(0, -2), True, True
* * * * Case 2
* * * * * * InsertPicture "C:\Users\mbramer\Desktop\R_RImages\2.jpg",
_
* * * * * * * * ActiveCell.Offset(0, -2), True, True
* * * * Case Else
* * * * * * MsgBox ("Wrong Values")
* * * * End Select

Thanks for your help!
Regards,
Matt

--

Dave Peterson- Hide quoted text -

- Show quoted text -

This is what I've came up with but I don't get an error, I get 5 of
the same "1.jpg" in cell "E1". *I think it may have something to do
with the Sub InserPicture but it's not my code and it's a bit over my
head. *Thanks for your reply and anyones' input.

Private Sub cmdTest_Click()
* * Dim myPath As String
* * Dim CellVal As String
* * Dim myRng As Range
* * Dim myCell As Range

* * myPath = "C:\Users\mbramer\Desktop\R_RImages"
* * CellVal = ActiveCell.FormulaR1C1

* * With Worksheets("Sheet1")
* * * * Set myRng = .Range("G1", .Cells(.Rows.Count, "G").End(xlUp))

* * * * For Each myCell In myRng.Cells
* * * * * * Select Case CellVal
* * * * * * Case "Test"
* * * * * * * * * * InsertPicture myPath & "\" & "1.jpg", _
* * * * * * * * * * * * ActiveCell.Offset(0, -2), True, True
* * * * * * Case "Test2"
* * * * * * * * * * InsertPicture myPath & "\" & "2.jpg", _
* * * * * * * * * * * * ActiveCell.Offset(0, -2), True, True
* * * * * * Case "Test3"
* * * * * * * * * * InsertPicture myPath & "\" & "3.jpg", _
* * * * * * * * * * * * ActiveCell.Offset(0, -2), True, True
* * * * * * Case Else
* * * * * * * * MsgBox ("No Values")
* * * * * * End Select
* * * * Next myCell
* * End With
End Sub

Sub InsertPicture(PictureFileName As String, TargetCell As Range, _
* * CenterH As Boolean, CenterV As Boolean)
' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
Dim p As Object, t As Double, l As Double, w As Double, h As Double
* * If TypeName(ActiveSheet) < "Worksheet" Then Exit Sub
* * If Dir(PictureFileName) = "" Then Exit Sub
* * ' import picture
* * Set p = ActiveSheet.Pictures.Insert(PictureFileName)
* * ' determine positions
* * With TargetCell
* * * * t = .Top
* * * * l = .Left
* * * * If CenterH Then
* * * * * * w = .Offset(0, 1).Left - .Left
* * * * * * l = l + w / 2 - p.Width / 2
* * * * * * If l < 1 Then l = 1
* * * * End If
* * * * If CenterV Then
* * * * * * h = .Offset(1, 0).Top - .Top
* * * * * * t = t + h / 2 - p.Height / 2
* * * * * * If t < 1 Then t = 1
* * * * End If
* * End With
* * ' position picture
* * With p
* * * * .Top = t
* * * * .Left = l
* * End With
* * Set p = Nothing
End Sub

--

Dave Peterson- Hide quoted text -

- Show quoted text -

We are getting real close. *I've changed the code with your input.
Now I get the same pic for each line that has a value. *I put Test,
Test2, Test3, and the word Input in Column G. *I get pic 1.jpg for
every line. *I deleted the pic thinking that there were multiple icons
there but this is the only one being inserted. *I changed this line:

CellVal = myCell.FormulaR1C1

But that gave me errors so I changed it back to:

CellVal = ActiveCell.FormulaR1C1

So SO SO close... Thanks so much for your help. *I can't think of

...

read more »- Hide quoted text -

- Show quoted text -

You are a genius and have solved the riddle. *Another quick question,
if you don't mind:

How can I use this code to look within a formula and not value. *Would
I change:

Select Case LCase(myCell.Value)
to
Select Case LCase(myCell.FormulaR1C1)

Many Thanks,
Matt

Forget about it. I googled it and modified the code. Excellent job
and many thanks again.

Matt

Is there a reason you want to use .formular1c1?

If you really have values (not formulas) in the cell, then .value would be much
more intuitive.

If you really have a formula, do you really want to inspect something like:

=VLOOKUP(RC[-1],Sheet2!C[-1]:C,2,FALSE)

I can't imagine where .formular1c1 would make sense in the kind of code that you
posted. But maybe you have some weird things to check????

RemyMaza wrote:

<<snipped

How can I use this code to look within a formula and not value. Would
I change:

Select Case LCase(myCell.Value)
to
Select Case LCase(myCell.FormulaR1C1)

Many Thanks,
Matt

--

Dave Peterson

On May 6, 9:20*am, Dave Peterson wrote:
Is there a reason you want to use .formular1c1?

If you really have values (not formulas) in the cell, then .value would be much
more intuitive.

If you really have a formula, do you really want to inspect something like:

=VLOOKUP(RC[-1],Sheet2!C[-1]:C,2,FALSE)

I can't imagine where .formular1c1 would make sense in the kind of code that you
posted. *But maybe you have some weird things to check????



RemyMaza wrote:

<<snipped

How can I use this code to look within a formula and not value. *Would
I change:

Select Case LCase(myCell.Value)
to
Select Case LCase(myCell.FormulaR1C1)

Many Thanks,
Matt

--

Dave Peterson

Yep, the values are referenced with a formula much like you posted.
I'm freestyling most of my code. I really haven't a clue what the
diff is from .Value and .formular1c1 or even the changes you did to
help me. Now that I think about it... Can you tell me what they
mean? LOL I think I'm going to have to do more things like this once
some people realize what we can do with VBA.

Regards,
Matt

If the cell contains a formula, then you can look at it in A1 reference style or
R1C1 reference style. If you want to try, put your favorite formula in a cell,
then do:

Tools|Options|General tab|and check/uncheck the R1C1 reference style option.

If you're typing text into the cell--not a formula, then I'd suggest that you
use .value. .Value is what you see in the formulabar.

If you put 1234.3216 in a cell and give it a nice number format (showing a comma
and only 2 decimal places), then the .value is still 1234.3216--even though you
see 1,234.33 in the cell in the worksheet.

So if you're using plain old values (numbers or text), you'd want to use
..value.

If for some (really weird!) reason, you wanted to see how the formula look in A1
reference style, you'd use .formula.

And if for some (really, really weird) reason, you wanted to see how the formula
looked R1C1 reference style, you'd use .formulaR1C1.

Another difference.

Put 1 in A1.
Put 2 in A2.
Put =sum(a1:a2) in A3.

The .value in A3 is: 3 (the result of the formula).
The .formula is: =Sum(A1:A2) (the "normal" formula)
the .formular1c1 is: =SUM(R[-2]C:R[-1]C) (the weird formula)

I'm still guessing you're either typing the value in the cell or you want to use
the results of the formula--not the formula itself.


RemyMaza wrote:

<<snipped
Yep, the values are referenced with a formula much like you posted.
I'm freestyling most of my code. I really haven't a clue what the
diff is from .Value and .formular1c1 or even the changes you did to
help me. Now that I think about it... Can you tell me what they
mean? LOL I think I'm going to have to do more things like this once
some people realize what we can do with VBA.

Regards,
Matt

--

Dave Peterson

On May 6, 10:40*pm, Dave Peterson wrote:
If the cell contains a formula, then you can look at it in A1 reference style or
R1C1 reference style. *If you want to try, put your favorite formula in a cell,
then do:

Tools|Options|General tab|and check/uncheck the R1C1 reference style option.