How to run a macro when a specify cell change value

P

pondok

Code:
--------------------

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim VRange As Range
Dim selectedRange As Object
Set VRange = Range("B2:B999") ' input range
If Not Intersect(Target, VRange) Is Nothing Then _
Application.Run "'Order Form.xls'!LoadPic"
End Sub

--------------------


For the above code, is it possible to make it to detect the value of
each non empty field, instead of having to set the range ?


Code:
--------------------

Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range)
' inserts a picture and resizes it to fit the TargetCells range
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
If Dir(PictureFileName) = "" Then Exit Sub
' import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
' determine positions

p.Width = p.Width * 0.7
p.Height = p.Height * 0.7


With TargetCells
t = .Top
l = .Left

w = .Offset(0, 1).Left - .Left
l = l + w / 2 - p.Width / 2
If l < 1 Then l = 1

h = .Offset(1, 0).Top - .Top
t = t + h / 2 - p.Height / 2
If t < 1 Then t = 1

End With

' position picture
With p
.Top = t
.Left = l

End With
Set p = Nothing
End Sub

Sub LoadPic()
Dim start As Integer
Dim Target As String
Dim size As Integer
Dim filename As String
Dim directory As String
Dim i As Integer
Dim selectedRange As Object


directory = "\\W2000server\Server\Drawings\"
Set selectedRange = Selection
i = 0
While i <= selectedRange.Count
filename = directory & selectedRange.Cells(i + 1, 1).Value & ".bmp"
InsertPictureInRange filename, Range(Cells(selectedRange.Row + i, selectedRange.Column + 1), Cells(selectedRange.Row + i, selectedRange.Column - 1))
i = i + 1
Wend
End Sub

--------------------


What i was given is:
- I type a list of numbers and then select the rows and run the macro
to get the image.

What I want is to have the image pops up on the next column everytime i
input a number no column B.

I have managed to activate it, but I need to make sure when I change
the value of a cell, it loads the images.

Would appreciate it if someone could help me quickly finish this task.
 
N

Norman Jones

Hi Pondok,

Try:

'=============>>
Private Sub Worksheet_Change(ByVal Target As Range)
Dim VRange As Range

Set VRange = Intersect(Me.Range("B2:B999"), Target)

If Not VRange Is Nothing Then
With VRange
If Not IsEmpty(.Value) And IsNumeric(.Value) Then _
Application.Run "'Order Form.xls'!LoadPic"
End With
End If
End Sub
'<<=============
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top