Resize cells to height of both

Try changing the Sub "auto_Height" to this:
 

Sub auto_Height()
'old title adjstPiclessRw()
'This is designed to make height fit the contents without adversely affecting the pictures'
    For Each Rw In ActiveSheet.UsedRange.Rows
        picfound = False
        For Each shp In ActiveSheet.Shapes
            If shp.TopLeftCell.Row = Rw.Row Then
                picfound = True
                shp.Height = shp.TopLeftCell.Height
                Exit For
            End If
        Next shp
        DoEvents
        If Not picfound Then Rw.Select: Rw.AutoFit
    Next Rw
End Sub

Select allOpen in new window

The sub now includes
shp.Height = shp.TopLeftCell.Height
which was  suggested by Saqib previously.

Note that all pictures will be resized to the row height of the row that the picture has been attached to.

Curt

Cool ok, looking...  Will it prevent more than one picture per cell?

It will prevent having more than one picture per cell and row if you want a different height of the pictures.
You can only have one height of a cell :-)
Cheers,
Curt

It looks like it is allowing multiple heights for cells.  Is it not supposed to?

Thanks for the help.  This has not been an easy one.

It did a bunch of this kind of stuff >> http://screencast.com/t/i7nOG9Ze where it made some of the pictures tiny.

What I mean is that you can only have one height of a row which means that all cells on that row will end up the same height. The rows where the pictures are attached to remains untouched but the pictures are re-sized to fit the height of the row. The height is determined by the first picture found on the row.

The picture in http://screencast.com/t/i7nOG9Ze is attached to row 681 and is therefore re-sized to the height of row 681. The code is re-sizing the pictures to the same height as the row they are attached to.

Curt

If you don't know which row your pictures are attached to, you can use this little macro to get the locations listed on a new sheet.

Curt

Sub Pictures_Found()
    Dim ws1 As Worksheet

    Set ws1 = Sheets.Add
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Pictures").Delete
    Application.DisplayAlerts = True
    ws1.Name = "Pictures"
    On Error GoTo 0
    i = 1
    Cells(i, 1) = "Row"
    Cells(i, 2) = "Picture"
    With ws1
        Worksheets("Studies").Activate
        For Each Shp In ActiveSheet.Shapes
            i = i + 1
            .Cells(i, 1) = Shp.TopLeftCell.Row
            .Cells(i, 2) = Shp.Name
        Next Shp
    End With
End Sub

Select allOpen in new window

I can see which ones they are attached to.  I don't want the first macro posted to shrink the size of the pictures.

It's very hard to see which rows the pictures are attached to just by looking at them. Try this macro and I think you will find that some pictures are not attached to the row you think they are attached to.

For example: Look at picture 40 and 277. They both looks like they are attached to row 112. Picture 40 is attached to row 112 but picture 277 is actually attached to row 111!

This new macro may put things in to a different light. Note also the 3rd column "Order found" which shows in which order Excel found the shapes.
 

Sub Pictures_Found()
    Dim ws1 As Worksheet

    Set ws1 = Sheets.Add
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Pictures").Delete
    Application.DisplayAlerts = True
    ws1.Name = "Pictures"
    On Error GoTo 0
    i = 1
    Cells(i, 1) = "Row"
    Cells(i, 2) = "Picture"
    Cells(i, 3) = "Order found"
    With ws1
        Worksheets("Studies").Activate
        For Each Shp In ActiveSheet.Shapes
            i = i + 1
            .Cells(i, 1) = Shp.TopLeftCell.Row
            .Cells(i, 2) = Shp.Name
            .Cells(i, 3) = i - 1
        Next Shp
        .Columns.AutoFit

        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
        With .Sort
            .SetRange Range("A2:C505")
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        .Activate
        Range("A1").Select

    End With
End Sub

Select allOpen in new window

So as you can see, your problems will not be solved by simply adjusting the row heights to the picture heights.

Curt

I have attached the results from running the Pictures_Found macro. I have highlighted all rows where you may have pictures attached to the wrong rows. As you can see there are quite a number of pictures which are attached to the "wrong" rows.

You must fix this before attempting to run any macros to adjust picture heights or row heights. VBA  code can achieve a lot of things but it needs some guide lines to work from.

Cheers,
Curt
Picture-Rows.xlsx

I have Mischelle on this one.  She is pretty new to all this but I have introduced her to the issue.  Since she put together the sheet to begin with, she is probably going to have the most luck resolving the issues with it.

I'll pass all your comments on to her so she can read what is said here.  Thanks for all the help.

Ted,

It looks like you have around 20 rows which have 3 pictures attached. I assume there should only be 2 pictures.

1. Fix those rows to have only 2 pictures. You can see which ones they are in the "PictureRows" file I posted or fix them one by one when Saqib's macro stops.
2. Run Saqib's excellent macro and all rows and pictures will be adjusted correctly.

Saqib certainly found the guidelines for the VBA code to produce miracles that I couldn't find!

Curt

Awesome!!

My outsourcer did some work to get rid of unwanted pictures.  I then ran the code in post 35421727 and it worked like a charm.  I have reattached the sheet.  Note that row 5 and 8 are examples of rows that are a little bit high still for the contents they contain.  Is there any way to fix that in those and subsequent non-picture rows?
tosstudies-6.14.xlsm

Ted, I am sorry but this is one of the areas where I would not be able to help you. I can only use excel's ability to resize rowheight based on the contents and excel is failing in some of them.

I suggest that you open a new question with only this issue and also include a sample file (not this 6.7MB one) which shows only a few rows which illustrate this problem. That way you may get some better response.

Saqib

Unbelievable stuff!