My code works and have it looping every 10 minutes to refresh some images. However the code I have made takes a minute to refresh each time. I think this maybe due to how I have written the range it's taking each cell and and placing the image line by line. Is there a way of grouping the selective range abit more so it refreshes the images at the same time rather than individual? It is doing this refresh task across 3 tabs.
Sub Images()
Application.ScreenUpdating = False
Application.Cursor = xlWait
Application.StatusBar = "Refreshing File. "
UserForm1.Show vbModeless
UserForm1.Caption = "Refreshing Jobs Please Wait"
Dim r1 As Range, r2 As Range, myMultipleRange As Range
Set r1 = Range("J8,J12,J16,J20,J24,J28,J32,J36,J40,J44,J48,J52,J56,J60,J64,J68,J72,J76,J80,J84,J88,J92,J96,J100,J104,J108,J112,J116,J120,J124")
Set r2 = Range("K8,K12,K16,K20,K24,K28,K32,K36,K40,K44,K48,K52,K56,K60,K64,K68,K72,K76,K80,K84,K88,K92,K96,K100,K104,K108,K112,K116,K120,K124")
Set myMultipleRange = Union(r1, r2)
For Each cell In r1
cell.Offset(0, -4).Select
If cell.Value = "" Then cell.Value = "1" And cell.Offset(0, 18).Select
If cell.Value = "1" Then cell.Offset(0, 20).Select
filepath = "https://api.qrserver.com/v1/create-qr-code/?size=150x150&data=" & (cell.Value)
With ActiveSheet.Pictures.Insert(filepath)
.ShapeRange.ScaleWidth 0.75, msoFalse, msoScaleFromTopLeft
.ShapeRange.ScaleHeight 0.75, msoFalse, msoScaleFromTopLeft
.ShapeRange.ScaleHeight 0.75, msoFalse, msoScaleFromTopLeft
.ShapeRange.Top = .TopLeftCell.Top + (.TopLeftCell.Height - .Height) / 2
.ShapeRange.Left = .TopLeftCell.Left + (.TopLeftCell.Width - .Width) / 2
End With
On Error Resume Next
Application.SendKeys ("{enter}")
Next
For Each cell In r2
cell.Offset(0, -2).Select
If cell.Value = "" Then cell.Value = "1" And cell.Offset(0, 20).Select
If cell.Value = "1" Then cell.Offset(0, 22).Select
filepath = "https://api.qrserver.com/v1/create-qr-code/?size=150x150&data=" & (cell.Value)
With ActiveSheet.Pictures.Insert(filepath)
.ShapeRange.ScaleWidth 0.75, msoFalse, msoScaleFromTopLeft
.ShapeRange.ScaleHeight 0.75, msoFalse, msoScaleFromTopLeft
.ShapeRange.ScaleHeight 0.75, msoFalse, msoScaleFromTopLeft
.ShapeRange.Top = .TopLeftCell.Top + (.TopLeftCell.Height - .Height) / 2
.ShapeRange.Left = .TopLeftCell.Left + (.TopLeftCell.Width - .Width) / 2
End With
On Error Resume Next
Application.SendKeys ("{enter}")
Next
Application.Goto Reference:=ActiveSheet.Range("a1"), Scroll:=True
ActiveSheet.Shapes("Button 1").Visible = False
ActiveSheet.Shapes("Button 2").Visible = True
Application.ScreenUpdating = True
Application.Cursor = xlDefault
Application.StatusBar = ""
UserForm1.Hide
Application.SendKeys ("{NumLock}")
End Sub
I believe it is just the way being a novice on how I have written the code and need to refine the selection. Just stuck on where to go with it now that I have got it this far.
