gringo287
02-14-2013, 02:08 PM
Hi,
The macro below works fine, but as i wrote it myself (I pillaged the Module vba from google)... It's highly likely to be very bloated.
The aim is to show the relevant image based on the user selection. The selection list is going to end up being 60 items long though which would make this vba massive, for such a simple task.
Is there a way to reference the images in a much more condensed method
sheet code
Sub blah3()
Application.ScreenUpdating = False
Sheets("Sheet1").Range("M7").Select
Call RemoveObjectsFromSelection
If Sheets("Sheet1").Range("A1").Value = "apple" Then
Sheets("Sheet2").Select
ActiveSheet.Shapes.Range(Array("Picture 2")).Select
Selection.Copy
Sheets("Sheet1").Select
Range("M7").Select
ActiveSheet.Paste
Else:
Sheets("Sheet1").Range("M7").Select
Call RemoveObjectsFromSelection
If Sheets("Sheet1").Range("A1").Value = "blackberry" Then
Sheets("Sheet2").Select
ActiveSheet.Shapes.Range(Array("Picture 3")).Select
Selection.Copy
Sheets("Sheet1").Select
Range("M7").Select
ActiveSheet.Paste
Else:
Sheets("Sheet1").Range("M7").Select
Call RemoveObjectsFromSelection
If Sheets("Sheet1").Range("A1").Value = "sony" Then
Sheets("Sheet2").Select
ActiveSheet.Shapes.Range(Array("Picture 4")).Select
Selection.Copy
Sheets("Sheet1").Select
Range("M7").Select
ActiveSheet.Paste
Else:
Sheets("Sheet1").Range("M7").Select
Call RemoveObjectsFromSelection
If Sheets("Sheet1").Range("A1").Value = "nokia" Then
Sheets("Sheet2").Select
ActiveSheet.Shapes.Range(Array("Picture 5")).Select
Selection.Copy
Sheets("Sheet1").Select
Range("M7").Select
ActiveSheet.Paste
Else:
Sheets("Sheet1").Range("M7").Select
Call RemoveObjectsFromSelection
If Sheets("Sheet1").Range("A1").Value = "htc" Then
Sheets("Sheet2").Select
ActiveSheet.Shapes.Range(Array("Picture 6")).Select
Selection.Copy
Sheets("Sheet1").Select
Range("M7").Select
ActiveSheet.Paste
Else:
Sheets("Sheet1").Range("M7").Select
Call RemoveObjectsFromSelection
If Sheets("Sheet1").Range("A1").Value = "lg" Then
Sheets("Sheet2").Select
ActiveSheet.Shapes.Range(Array("Picture 7")).Select
Selection.Copy
Sheets("Sheet1").Select
Range("M7").Select
ActiveSheet.Paste
Else:
Sheets("Sheet1").Range("M7").Select
Call RemoveObjectsFromSelection
If Sheets("Sheet1").Range("A1").Value = "samsung" Then
Sheets("Sheet2").Select
ActiveSheet.Shapes.Range(Array("Picture 8")).Select
Selection.Copy
Sheets("Sheet1").Select
Range("M7").Select
ActiveSheet.Paste
End If
End If
End If
End If
End If
End If
End If
End Sub
module
Sub RemoveObjectsFromSelection()
Dim ole As OLEObject
Dim shp As Shape
For Each ole In Selection.Parent.OLEObjects
If Not Application.Intersect(Selection, _
ole.TopLeftCell) Is Nothing Then
ole.Delete
End If
Next ole
For Each shp In Selection.Parent.Shapes
If Not Application.Intersect(Selection, _
shp.TopLeftCell) Is Nothing Then
shp.Delete
End If
Next shp
End Sub
The macro below works fine, but as i wrote it myself (I pillaged the Module vba from google)... It's highly likely to be very bloated.
The aim is to show the relevant image based on the user selection. The selection list is going to end up being 60 items long though which would make this vba massive, for such a simple task.
Is there a way to reference the images in a much more condensed method
sheet code
Sub blah3()
Application.ScreenUpdating = False
Sheets("Sheet1").Range("M7").Select
Call RemoveObjectsFromSelection
If Sheets("Sheet1").Range("A1").Value = "apple" Then
Sheets("Sheet2").Select
ActiveSheet.Shapes.Range(Array("Picture 2")).Select
Selection.Copy
Sheets("Sheet1").Select
Range("M7").Select
ActiveSheet.Paste
Else:
Sheets("Sheet1").Range("M7").Select
Call RemoveObjectsFromSelection
If Sheets("Sheet1").Range("A1").Value = "blackberry" Then
Sheets("Sheet2").Select
ActiveSheet.Shapes.Range(Array("Picture 3")).Select
Selection.Copy
Sheets("Sheet1").Select
Range("M7").Select
ActiveSheet.Paste
Else:
Sheets("Sheet1").Range("M7").Select
Call RemoveObjectsFromSelection
If Sheets("Sheet1").Range("A1").Value = "sony" Then
Sheets("Sheet2").Select
ActiveSheet.Shapes.Range(Array("Picture 4")).Select
Selection.Copy
Sheets("Sheet1").Select
Range("M7").Select
ActiveSheet.Paste
Else:
Sheets("Sheet1").Range("M7").Select
Call RemoveObjectsFromSelection
If Sheets("Sheet1").Range("A1").Value = "nokia" Then
Sheets("Sheet2").Select
ActiveSheet.Shapes.Range(Array("Picture 5")).Select
Selection.Copy
Sheets("Sheet1").Select
Range("M7").Select
ActiveSheet.Paste
Else:
Sheets("Sheet1").Range("M7").Select
Call RemoveObjectsFromSelection
If Sheets("Sheet1").Range("A1").Value = "htc" Then
Sheets("Sheet2").Select
ActiveSheet.Shapes.Range(Array("Picture 6")).Select
Selection.Copy
Sheets("Sheet1").Select
Range("M7").Select
ActiveSheet.Paste
Else:
Sheets("Sheet1").Range("M7").Select
Call RemoveObjectsFromSelection
If Sheets("Sheet1").Range("A1").Value = "lg" Then
Sheets("Sheet2").Select
ActiveSheet.Shapes.Range(Array("Picture 7")).Select
Selection.Copy
Sheets("Sheet1").Select
Range("M7").Select
ActiveSheet.Paste
Else:
Sheets("Sheet1").Range("M7").Select
Call RemoveObjectsFromSelection
If Sheets("Sheet1").Range("A1").Value = "samsung" Then
Sheets("Sheet2").Select
ActiveSheet.Shapes.Range(Array("Picture 8")).Select
Selection.Copy
Sheets("Sheet1").Select
Range("M7").Select
ActiveSheet.Paste
End If
End If
End If
End If
End If
End If
End If
End Sub
module
Sub RemoveObjectsFromSelection()
Dim ole As OLEObject
Dim shp As Shape
For Each ole In Selection.Parent.OLEObjects
If Not Application.Intersect(Selection, _
ole.TopLeftCell) Is Nothing Then
ole.Delete
End If
Next ole
For Each shp In Selection.Parent.Shapes
If Not Application.Intersect(Selection, _
shp.TopLeftCell) Is Nothing Then
shp.Delete
End If
Next shp
End Sub