Need help with VBA - range looping

wjvghost

New Member
Joined
Jan 20, 2017
Messages
41
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:

Code:
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.
 
Which part of the code is slowing things down?
 
Upvote 0

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
The process of loading the images in a large quantity seems to be the problem.

I don't think Excel handles well as an web/image processor.

I'm not exactly sure what the problem is, but it is freezing all Office apps until it is finished.
 
Upvote 0
As far as I can see the code is loading the images one by one, not all in one go.

Have you considered downloading and storing the images locally and then inserting them into the Excel sheet?
 
Upvote 0
I have tried something loosely related to this.

Originally I made a separate module which on click would download the image of the active cell to a specified folder and it worked fine.

/edit this was for an image by image basis and not intended for any download en masse.


The problem I was running into was when I distributed this spreadsheet to my team, the Kaspersky anti-virus which we use was flagging the email as potential malware and would proceed to quarantine.

It did not appear to actually do anything to the spreadsheet when it passed through, but when I was reading the quarantine report it indicated that the act of automatically saving files to the computer was the cause of the issue.

I know nothing in the spreadsheet in harmful, but when presenting this project to a superior it does not go well if they see that was flagged through our email security.

To answer your question, I have not used the local save and insert image method the way you are asking.
 
Last edited:
Upvote 0
Would saving locally be an option?
 
Upvote 0
I think if it worked quicker than the current method of pulling them straight from the website then it would be a viable solution.

/edit

my spreadsheet works the way I intend it to work, but I am looking to make it quicker - that's all.
 
Last edited:
Upvote 0
I would imagine inserting images from a local folder would be quicker than from the Web.

If you have the URL for a file then you can use code like this to download it to a specific folder with a name you specify.
Code:
Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
                                           "URLDownloadToFileA" ( _
                                           ByVal pCaller As Long, ByVal szURL As String, _
                                           ByVal szFileName As String, _
                                           ByVal dwReserved As Long, _
                                           ByVal lpfnCB As Long) As Long

Function DownloadFileFromWeb(strURL As String, strSaveName As String, strSavePath As String) As Boolean
Dim returnValue As Long

    returnValue = URLDownloadToFile(0, strURL, strSavePath & strSaveName, 0, 0)

    DownloadFileFromWeb = returnValue = 0

End Function
 
Upvote 0

Forum statistics

Threads
1,215,219
Messages
6,123,681
Members
449,116
Latest member
HypnoFant

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top