Select Range and Find Values ***Maybe Loop?***

[RemyMaza]

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]

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 "Picture: " & 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]

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 "Picture: " & myPictName & " wasn'tfound"
            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.  Thisline
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









--

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]

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]

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.












--

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

 

[RemyMaza]

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.












--

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!

 

[Dave Peterson]

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]

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









...

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

 

[RemyMaza]

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

 

[Dave Peterson]

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]

Is there a reason you want to use .formular1c1?

If you really have values (not formulas) in the cell, then .value would bemuch
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:

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

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]

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]

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 acomma
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 lookin 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                      (theresult 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:

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

Nice. I think I was mistaken before. I recorded a macro and the
macro used .formular1c1. What I really need is a combination
of .value and .formula. Thanks Dave.