Need help with VBA - range looping

[wjvghost]

Hello,

I have been working on a spreadsheet which catalogues images from my website to show what has been uploaded and what has not. With the volume of product with which I am working, this seems to be the "quicker" option to take - using Excel. This method is more efficient for me because it queries my image server with a "fresh" image and does not give an old cached image, but sometimes looking at it through my product catalog via web browser will, no matter how many times I flush the web browser.

However, after upgrading to Office 2013 (from Office 2010) I have noticed there is a lot of performance degredation. What would work fine in Excel 2010, now gives issues in 2013. Namely, trying to run the script below on any number of products:

Sub insertImage()

Dim rng As Range
Dim Cell As Range
Dim Pic As Picture

    Set rng = Range("L2:U" & Range("L" & Rows.Count).End(xlUp).Row)
    For Each Cell In rng
        With Cell
            On Error Resume Next
            Set Pic = .Parent.Pictures.Insert(.Value)
            If Err <> 0 Then
                Err.Clear
            Else
                With .Offset(, 0)
                    Pic.top = .top
                    Pic.Left = .Left
                    Pic.Height = 56 '412 at 550 cell size
                    Pic.Width = 56 '412 at 550 cell size
                    ActiveSheet.Hyperlinks.Add Anchor:=Pic.ShapeRange.Item(1), Address:= _
            Cell.Value
            Cell.ClearContents
                End With
            End If
            On Error GoTo 0
        End With
    Next Cell

End Sub

brief explanation of the script: it reads each cell within range of L2 through U, which in another script its coded to fill up L2 all the way through U501 if the information is available. If any cell within this L2:U501 range has a value with a hyperlink prefix then it pulls the image and adds it into the corresponding cell, then deletes the cell contents of the hyperlink.

I do not proclaim to be any sort of Excel VBA pro or expert, but I am able and willing to learn.

This module makes every Microsoft Office application hang until it is done looping through the range, which is unfortunate because I am not able to use Word or even check my emails in Outlook until the process is finished.

I know there is a better way to do this, but I was unable to figure it out and got to the "busy time of the year" of my company's peak sales period.

Now since I have some downtime, I am looking to improve upon the spreadsheet.

My question, is there a better way to go about doing something like this? I have been looking around, but I am actually unsure of what I should use to make it better.

I have seen suggestions for using a For i = 1 to whatever loop, but I'm not sure how I'd incorporate that into my existing script. I've also seen a suggestion for a DoEvents which would free up Office applications, but again not sure what I'd be doing with it.

If anyone can help me or point me in the right direction that would be great. Also, if any more information is needed I can provide what is needed.

 

[wjvghost]

bump

 

[Norie]

Have you stepped through the code to see how/why it's hanging?

Also, what error(s) are you trying to handle with the On Error Resume Next?

 

[wjvghost]

Thanks for the reply,

The hanging seems to be related to the "update" from Office 2010 to 2013. This issue never affected all Office products in 2010 - it only would hang in Excel but that's understandable because it was trying to read several lines of hyperlinks and validate them along with inserting pictures via this code shown. My guess is it's just a design flaw of Office 2013 or a flaw in the way I have the code written. I don't know enough on the code side yet to explore the systematic problem of why all Office apps hang.

This has been tested on 2010 and 2013 Office computers, so I am pretty confident in saying it is Office 2013 handling the code differently on a system resource level.

And the error handling is in place because sometimes a cell will be empty and the code will break on an empty cell.

 

[Norie]

Why not check if the cell is empty instead of using On Error Resume Next?

Using On Error Resume Next will ignore not only the error caused by that but any other error in the code?

 

[wjvghost]

The module was first tried without using any error catching and it was suggested that I start using it whenever errors were being thrown to see what the code would do if allowed to fully execute.

It works with the On Error Resume Next in there, however if I comment it out then I get a:

Run-time error '1004':

Unable to get the Insert property of the Pictures class

on this bit of code:

Set Pic = .Parent.Pictures.Insert(.Value)

If something in the code doesn't look right in a developer sense then it's probably because I didn't do it how it should be the proper way.

 

[Norie]

Rather than using an all encompassing On Error Resume Next you should try and handle the errors where they will occur.

In this case, assuming the error is caused by the cell being empty, you could try something like this.

Sub insertImage()

Dim rng As Range
Dim Cell As Range
Dim Pic As Picture

    Set rng = Range("L2:U" & Range("L" & Rows.Count).End(xlUp).Row)
    For Each Cell In rng
        With Cell
            If .Value <> "" Then
                Set Pic = .Parent.Pictures.Insert(.Value)
                With .Offset(, 0)
                    Pic.Top = .Top
                    Pic.Left = .Left
                    Pic.Height = 56    '412 at 550 cell size
                    Pic.Width = 56    '412 at 550 cell size
                    ActiveSheet.Hyperlinks.Add Anchor:=Pic.ShapeRange.Item(1), Address:= _
                                               Cell.Value
                    Cell.ClearContents
                End With
            End If
        End With
    Next Cell

End Sub

If there could be other reasons for the error you could try this.

Sub insertImage()
Dim rng As Range
Dim Cell As Range
Dim Pic As Picture

    Set rng = Range("L2:U" & Range("L" & Rows.Count).End(xlUp).Row)
    
    For Each Cell In rng
        With Cell

            On Error Resume Next
            Set Pic = .Parent.Pictures.Insert(.Value)
            On Error GoTo 0

            If Not Pic Is Nothing Then
                With .Offset(, 0)
                    Pic.Top = .Top
                    Pic.Left = .Left
                    Pic.Height = 56    '412 at 550 cell size
                    Pic.Width = 56    '412 at 550 cell size
                    ActiveSheet.Hyperlinks.Add Anchor:=Pic.ShapeRange.Item(1), Address:= _
                                               Cell.Value
                    Cell.ClearContents
                End With
            End If
        End With

        Set Pic = Nothing

    Next Cell

End Sub

PS Have you tried stepping through the code to see what's happening?

You can step through the code line by line from the start by using F8 or you can do it from a specific point by inserting a breakpoint using F9.

 

[wjvghost]

I ran your second code block and it seemed to be fine.

The problem isn't this module itself, in my opinion, it is fine the way it is but I'll continue to use what you provided me. Thank you

The spreadsheet has a Product ID column which is where I put in the numeric information for each product I want to lookup.

Another module runs a formula + the Product ID info to generate all possible web links that could be associated to that item.

Each item has 9-14 possible associated links, which are then validated and all the bad links are deleted.

Everything up to this point works perfectly fine, within a reasonable amount of time.

If for example, I am working on say... 10 items then that is a possibility of 10-140 images which could be loaded with the script in this topic.

This was not an issue in 2010, as it would just cause only Excel to hang until the process of loading all 10 of these items was finished.

However, in 2013, now everything related to Office hangs because this image load script is attempting to load it all.

It's not as noticeable when I am not working with a lot of product, but sometimes I can have upwards of hundreds of Product IDs.

In the hundreds of PIDs range, this script can take sometimes half an hour or longer to run which is still faster than doing this all manually but I feel like this can be faster.

I read somewhere about the DoEvents function being able to alleviate this issue, but I don't know how to properly use it.

 

[Norie]

I realise the problem might not be with the code itself, that's why I'm suggesting you step through the code to see what's actually happening.

If you do that you might find out what the reason is for it performing so slowly in 2013.

By the way, what do you mean by 'attempting to load it all'?

'all' what?

As far as I can see this code doesn't interact with any other applications.

 

[wjvghost]

It is loading hyperlinks from cells within the L2 through U whatever range and overlaying the image from the hyperlink for each cell.

"Attempting to load it all" means loading every image into the spreadsheet and resizing them to the exact size of the cells.

This doesn't interact with any other applications. The issue I am having is that it is affecting other applications because of how the newer versions of Office have been made.

The code works fine, I have tested it and retested. The only time the issue occurs is when multiple products are being loaded, like a lot of them.

In it's fullest capacity which I have set to a max of 500 Product IDs, this means it has to load and resize a potential 5000 images. It will never be at full capacity, but any large number of products makes it happen.


|Product|main|alt2 |alt3 | etc through alt9
|--------------------------
| #### | link | link | link |
| #### | link | link | link |
| #### | link | link | link |


This rough representation shows what I have in my workbook.

When this module runs it takes these links and loads the image in its place.

/edit assume the visual is a properly aligned table.