Help With Worksheet Change Code

[Dazzawm]

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?

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

 

[jkpieterse]

Sure:

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

 

[Dazzawm]

Sure:

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?

 

[bebo021999]

Try not to use whole column
Range("AE:AE")
use this:
Range("AE1:AE1000")
if 1000 is maximum used rows

 

[Dazzawm]

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?

 

[jkpieterse]

Or perhaps change to this:

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

 

[Alex Blakenburg]

Perhaps restrict the loop a bit more by adding Columns("AE")

For Each rng In Intersect(Target, Me.Columns("AE"), Me.UsedRange)

How many values in AE are you changing at the one time ?

 

[Dazzawm]

Perhaps restrict the loop a bit more by adding Columns("AE")

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.

 

[Dazzawm]

I get the error below when I close workbook

Points to this line when I debug

For Each rng In Intersect(Target, Me.UsedRange)

 

[jkpieterse]

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.