|
-
Aug 19th, 2009, 01:11 PM
#1
Thread Starter
Addicted Member
[Excel 2003] Check for Autofill on Worksheet_Change event?
Does anyone know if it's possible to check, on the Worksheet_Change event, if autofill is the reason for the change?
I basically have a change event so that I can monitor if someone enters something in the first column. If the target range is in the first column, I perform a vlookup from a table, and plug in the corresponding value in the second column. (I'm not using vlookup formulas in the cells because it's messy for quite a few reasons).
However, in the case that someone is copying and pasting or auto-filling into both the first and second column, I was getting some wierd results. I have the copy-paste issue fixed, as I can check on application.cutcopymode. But, I can't seem to find some equivalent for autofill.
Here's my code so far:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rIsect As Variant
Dim rWctr As Range
Dim rCell As Range
Dim rLookup As Range
Dim MyCell As Variant
Dim rList As Range
'---Check to see if a workcenter was entered & look up the corresponding area if so---------
Set rWctr = Me.Range("A:A")
Set rCell = Me.Range("B:B")
Set rLookup = ActiveWorkbook.Sheets("Areas").Range("A:C")
'turn off events to prevent an infinite loop
Application.EnableEvents = False
Set rIsect = Application.Intersect(Target, rCell)
If rIsect Is Nothing Then
'the changed values do not include somthing from the cell column
On Error GoTo e1
For Each MyCell In Target
If MyCell.Value <> "" Or MyCell.Value <> 0 Or MyCell.Value <> Empty Then
Set rIsect = Application.Intersect(MyCell, rWctr)
If rIsect Is Nothing Then
'do nothing
Else
MyCell.Offset(0, 1).Value = Application.WorksheetFunction.VLookup(Target.Value, _
rLookup, 3, False)
End If
End If
r1:
Next MyCell
Else
'the changed values DO include somthing from the cell column
If Application.CutCopyMode = False Then
'nothing is being cut or copied
On Error GoTo e2
For Each MyCell In Target
If MyCell.Value <> "" Or MyCell.Value <> 0 Or MyCell.Value <> Empty Then
Set rIsect = Application.Intersect(MyCell, rWctr)
If rIsect Is Nothing Then
'do nothing
Else
MyCell.Offset(0, 1).Value = Application.WorksheetFunction.VLookup(Target.Value, _
rLookup, 3, False)
End If
End If
r2:
Next MyCell
Else
'something is being cut or copied, don't change anything
End If
End If
'Other stuff (not related), cut out
'...
'turn events back on
Application.EnableEvents = True
Exit Sub
e1:
If MyCell.Offset(0, 1).Value <> "" Or MyCell.Offset(0, 1).Value <> 0 _
Or MyCell.Offset(0, 1).Value = Empty Then
MyCell.Offset(0, 1).Value = "N/A"
End If
Resume r1
e2:
If MyCell.Offset(0, 1).Value <> "" Or MyCell.Offset(0, 1).Value <> 0 _
Or MyCell.Offset(0, 1).Value = Empty Then
MyCell.Offset(0, 1).Value = "N/A"
End If
Resume r2
End Sub
Tags for this Thread
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|