Insert Pics Macro Not Working on All Cells unless name manually typed in

[BigDawg15]

Hello,

Using macros from different projects, I have put together this workbook for college football schedules. After using a macro to insert the names for the
games for each team in each division, I want to enter the corresponding helmet from a folder. Currently it will work if I manually enter the team names
but not after running the copydata macro and have all names inserted.

I tried running a macro to format all cells as General or Text but doesn't seem to have any effect.

Any help would be greatly appreciated.

BigDawg15

[mdmackillop]

Give this a try

Sub MikePics1()
 Dim MyRange As Range
 Dim picname As String
 Dim rcell As Range
 Dim Mypath As String
 
 Mypath = "E:\Football\"
 
 Set MyRange = ActiveSheet.Range("B3:AC15")
 For Each rcell In MyRange
    If Len(rcell.Value) > 0 Then
        picname = Mypath & rcell.Value & ".jpg"
         If Len(Dir(picname)) > 0 Then
     do_insertPic picname, rcell.Left, rcell.Top 
End If
     End If
Next
Application.ScreenUpdating = True
End Sub


Private Sub do_insertPic(ByRef picname As String, myleft As Long, mytop As Long)
    Dim Pic
    Set Pic = ActiveSheet.Pictures.Insert(picname)
    With Pic
     .Left = myleft
     .Top = mytop
     .ShapeRange.LockAspectRatio = msoFalse
    End With
End Sub

[BigDawg15]

Mac,

No go. I get "Unable to get the Insert property of the Picture class" error which I assume errors out if a Pic is not in the folder for the name listed? If I insert "On Error Resume Next" it will
insert the pictures but only for the cells I have manually entered the names into (the first column on each work sheet and other random cells for testing). Not sure why.

Any help you can provide is appreciated.

Thanks,

BigDawg15

[mdmackillop]

This will check that the pic file exists; previous post amended.

If Len(Dir(picname)) > 0 Then
            do_insertPic picname, rcell.Left, rcell.Top
            End If

[BigDawg15]

Mac,

Still a no go. No error but only pastes pics into cells where the name has been manually entered.

BigDawg15

[mdmackillop]

Which macro is entering the names? I'm struggling with no pictures etc.

[BigDawg15]

Mac,

You provided me the code below for a project I was working on last week. I am trying to incorporate into this into this workbook and seems to work fine. After running this macro
I run the MikePics1 macro to insert the pics into the cells with the team names in them. Currently it will only insert the pics into Column B on each worksheet it is run on (these names are
manually entered). If I go into a worksheet and type the name over what was placed there by the copydata macro the pic will be entered.

I hope that is a bit clearer.

Option Explicit
 
Sub CopyData()
    Dim r As Range, cel As Range, ws As Worksheet
    Dim Rw&, Col&, Grp$, Nm$
    
On Error Resume Next
    With Sheets("Activities")
        Set r = Range(.Cells(2, 5), .Cells(Rows.Count, 5).End(xlUp))
    End With
    For Each cel In r
        If Len(cel) > 3 Then
            Grp = Replace(cel.Offset(, 1), "'", "")
            Set ws = Worksheets(Grp)
            Col = ws.Rows(1).Find(cel.Offset(, -3)).Column
            Nm = Replace(cel.Offset(, 2), "'", "")
            Rw = ws.Columns(2).Cells.Find(Nm, lookat:=xlWhole).Row
            ws.Cells(Rw, Col).Value = cel.Value
           'Ws.Cells(Rw, Col).Interior.ColorIndex = 8 ' Can be deleted
        End If
    Next cel
End Sub

Thanks again for your help,

Mike

[BigDawg15]

Mac,

On a hunch I inserted and ran a macro to remove all leading and trailing spaces and then ran the MikePics1 macro and it seems to work properly.
So it appears there are leading and trailing spaces copied over that need to be removed to work properly, but I think I got it working properly (well you
got it working properly and I got lucky).

Thank you again for your help.

Cheers,

Mike