Loop this code???

[gottimd]

Is there a way to make this code go to the next available row below and if the cell it is looking at is blank, to end the code.

    Dim picnme As String
    Dim rng As Range
    picnme = Range("N6")
 
Range("H6").Select
    ActiveSheet.Pictures.Insert( _
        "C:\Documents and Settings\Pictures\" & picnme & ".jpg").Select
    Selection.ShapeRange.ScaleHeight 0.53, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleWidth 0.88, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 1.08, msoFalse, msoScaleFromTopLeft

The picnme for the next code would equal
picnme= Range("N7")

and the first part of the code would then say
Range("H7").select

Rather than going and typing each line in sequence, is there a way to make this code go to the next row down and follow the same procedures, and loop?

 

[gottimd]

Okay, I changed it so the picnme= Range("h6")

and the first line is Range("h6").select

So it is the same code following, except now the next line or part of the loop would drop down to the next line and be

picnme=("h7")

and the first line is Range("h7").Select

How do I loop this so it continues to drop down to the next row (ie, next line would be "H8", and continue until the value in the column H is nothing?

 

[gottimd]

Bump.....

anyone know how to loop this

    Dim picnme As String 
    Dim rng As Range 
    picnme = Range("h6") 

Range("H6").Select 
    ActiveSheet.Pictures.Insert( _ 
        "C:\Documents and Settings\Pictures\" & picnme & ".jpg").Select 
    Selection.ShapeRange.ScaleHeight 0.62, msoFalse, msoScaleFromTopLeft

so that it goes to the next row down (h7) and continues to go to the next row down until there is no value in the H row, and stop if there is no row, rather than copying and pasting the code 1500 times and changing each number to one more than the last one (ie h7 to h8 to h9, etc)?[/code]

 

[HalfAce]

I'm not really following your code, but probably don't need to if I understand what you're after. If I get your intent then maybe something like this will help out.

<font face=Courier New> <SPAN style="color:#00007F">Dim</SPAN> picnme <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> rng <SPAN style="color:#00007F">As</SPAN> Range, i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, x <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#007F00">'   picnme = Range("N6")</SPAN>

<SPAN style="color:#007F00">'Range("H6").Select</SPAN>
x = [H65536].End(xlUp).Row
For i = 6 To x
    picnme = Cells(i, 14)
    ActiveSheet.Pictures.Insert( _
        "C:\Documents and Settings\Pictures\" & picnme & ".jpg").Select
    Selection.ShapeRange.ScaleHeight 0.53, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleWidth 0.88, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 1.08, msoFalse, msoScaleFromTopLeft
    
<SPAN style="color:#00007F">Next</SPAN> i</FONT>

Hope it helps,
Dan

 

[gottimd]

I tried to incorporate that into the code, and it is giving me an error on the
Insert Pic line of the code:

    Application.ScreenUpdating = False

    Dim picnme As String
    Dim rng As Range, i As Long, x As Long
    picnme = Range("H6")
    
     
    Range("H6").Select
    x = [H65536].End(xlUp).Row
    For i = 6 To x
    picnme = Cells(i, 8)
    ActiveSheet.Pictures.Insert( _
        "C:\Documents and Settings\Pictures\" & picnme & ".jpg").Select
    Selection.ShapeRange.ScaleHeight 0.62, msoFalse, msoScaleFromTopLeft
    
   Next i

    
    Application.ScreenUpdating = True

End Sub

Did I do something wrong?

 

[gottimd]

This code, at the Activeinsert picture line says it can't get picture class. However, it did place all of the logos on top of eachother in the same cell, of H6.

Not sure if it gave me an error at the end of the cycle/loop because in the scenario I am testing, beginning at h335, the value in the cell = " " (blank) because the cell it is referring to is blank. How at the end of the code can I put an if statement like if it is null value then to exit code.

 

[HalfAce]

Not sure if it'll help or not, but try this...

<font face=Courier New>Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN>

<SPAN style="color:#00007F">Dim</SPAN> picnme <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> rng <SPAN style="color:#00007F">As</SPAN> Range, i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, x <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>

<SPAN style="color:#007F00">' picnme = Range("H6")</SPAN>


<SPAN style="color:#007F00">' Range("H6").Select</SPAN>
x = [H65536].End(xlUp).Row
For i = 6 To x
On Error Resume <SPAN style="color:#00007F">Next</SPAN>
picnme = Cells(i, 8)
ActiveSheet.Pictures.Insert( _
"C:\Documents and Settings\Pictures\" & picnme & ".jpg").Select
Selection.ShapeRange.ScaleHeight 0.62, msoFalse, msoScaleFromTopLeft

<SPAN style="color:#00007F">Next</SPAN> i


Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN>

<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>


Any better?
Dan

Edit:
You shouldn't need to look for a null value to exit the code, as the range to work with is defined as from row 6 to the last row in column H with a value.

 

[gottimd]

Ok, that made the error message go away, however....

all of the pictures are still being placed into one cell over top eachother. I was hoping to get it where the first picture pulled is put into h6, next one put into h7, and so on and so forth.

 

[HalfAce]

That's my intent too.
If you've made any changes, can I see your code now?

 

[gottimd]

    Application.ScreenUpdating = False

    Dim picnme As String
    Dim rng As Range, i As Long, x As Long

    Range("h6").Select
    x = [H65536].End(xlUp).Row
    For i = 6 To x
    On Error Resume Next
    picnme = Cells(i, 8)
    ActiveSheet.Pictures.Insert( _
        "C:\Documents and Settings\Pictures\" & picnme & ".jpg").Select
    Selection.ShapeRange.ScaleHeight 0.62, msoFalse, msoScaleFromTopLeft
    
   Next i

       Application.ScreenUpdating = True

End Sub

I noticed you have " ' " where it names the cell (in bold). If I do that, it places the picture somewhere else, so I had to take the " ' " off and put it into the code.