Help With Worksheet Change Code

Dazzawm

Well-known Member
Joined
Jan 24, 2011
Messages
3,816
Office Version
  1. 365
Platform
  1. Windows
I have the code below that when I enter a number into a cell in column AE on sheet 1 it changes to what is the corresponding number in column A on sheet 2 to what is next to it in column B on sheet 2. It works fine but if I select multiple cells at once and paste nothing happens, is there a slight tweak that will overcome this please?

Code:
Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("AE:AE")) Is Nothing Then
        Application.EnableEvents = False
        If IsNumeric(Application.Match(Target.Value, Sheets("Sheet2").Columns("A"), 0)) Then
            Target.Value = Application.VLookup(Target, Sheets("Sheet2").Range("A:B"), 2, 0)
        End If
        Application.EnableEvents = True
    End If
End Sub
 
Sure:
VBA Code:
Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range

    If Not Intersect(Target, Range("AE:AE")) Is Nothing Then
        Application.EnableEvents = False
        For Each rng In Target
            If IsNumeric(Application.Match(rng.Value, Sheets("Sheet2").Columns("A"), 0)) Then
                rng.Value = Application.VLookup(rng, Sheets("Sheet2").Range("A:B"), 2, 0)
            End If
        Next
        Application.EnableEvents = True
    End If
End Sub
 
Upvote 0
Sure:
VBA Code:
Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range

    If Not Intersect(Target, Range("AE:AE")) Is Nothing Then
        Application.EnableEvents = False
        For Each rng In Target
            If IsNumeric(Application.Match(rng.Value, Sheets("Sheet2").Columns("A"), 0)) Then
                rng.Value = Application.VLookup(rng, Sheets("Sheet2").Range("A:B"), 2, 0)
            End If
        Next
        Application.EnableEvents = True
    End If
End Sub
Thanks that works, however. I already have the workbook as macro enabled as I have some before close code. But with this code in sheet 1 when I try closing the circle keeps running and doesn't seem to close?
 
Upvote 0
Try not to use whole column
Range("AE:AE")
use this:
Range("AE1:AE1000")
if 1000 is maximum used rows
 
Upvote 0
Try not to use whole column
Range("AE:AE")
use this:
Range("AE1:AE1000")
if 1000 is maximum used rows
Thanks but will be used on different files with multiple thousand rows and different amounts in each file. @jkpieterse code works fine it's just the file won't close. I had to force close after 15 mins and lost all changes?
 
Upvote 0
Or perhaps change to this:

VBA Code:
Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range

    If Not Intersect(Target, Range("AE:AE")) Is Nothing Then
        Application.EnableEvents = False
        For Each rng In Intersect(Target, Me.UsedRange)
            If IsNumeric(Application.Match(rng.Value, Sheets("Sheet2").Columns("A"), 0)) Then
                rng.Value = Application.VLookup(rng, Sheets("Sheet2").Range("A:B"), 2, 0)
            End If
        Next
        Application.EnableEvents = True
    End If
End Sub
 
Upvote 0
Perhaps restrict the loop a bit more by adding Columns("AE")
Rich (BB code):
For Each rng In Intersect(Target, Me.Columns("AE"), Me.UsedRange)

How many values in AE are you changing at the one time ?
 
Upvote 0
Perhaps restrict the loop a bit more by adding Columns("AE")
Rich (BB code):
For Each rng In Intersect(Target, Me.Columns("AE"), Me.UsedRange)

How many values in AE are you changing at the one time ?
You mean how many am I pasting at once? It wont be many.
 
Upvote 0
I get the error below when I close workbook

1739376152993.png


Points to this line when I debug

For Each rng In Intersect(Target, Me.UsedRange)
 
Upvote 0
That means some code in your workbook_beforeclose event is trying to clear cells in an area which is outside of the used range of the worksheet.
 
Upvote 0

Forum statistics

Threads
1,226,771
Messages
6,192,919
Members
453,767
Latest member
922aloose

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