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