How to loop faster?

[BRB1983]

i have a code when on cell change then loop and fine matching value. then offset and paste in cell to left.
code works fine but need it to work faster. Any help would be appreciated.

Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Set KeyCells = Sheet1.Range("C2:C50")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
    Is Nothing Then
      
Dim i As Long
Dim j As Long
Dim lastrow As Long
Dim ws As Worksheet, ws2 As Worksheet
    Set ws = Sheet1
    Set ws2 = Sheet2
    For i = 2 To 5000
        If IsEmpty(ws.Range("C" & i)) Then
            Exit For
        End If
    For j = 2 To 5000
        If IsEmpty(ws2.Range("E" & j)) Then
            Exit For
        End If
If ws.Range("C" & i).Text = ws2.Range("E" & j).Text Then
    If ws.Range("B" & i).Value = "" Then
        ws.Range("B" & i).Value = ws2.Range("E" & j).Value & "-" & ws2.Range("B" & j).Value
    Exit For
End If
    End If
    Next j
    Next i
End If

End Sub

 

[BRB1983]

right, sorry..

 

[BRB1983]

try using variant arrays instead of referencing the worksheet multiple times in a loop.
this code in untested but should show you how to do it ans will be much faster:

Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Set KeyCells = Sheet1.Range("C2:C50")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
    Is Nothing Then
    
Dim i As Long
Dim j As Long
Dim lastrow As Long
Dim ws As Worksheet, ws2 As Worksheet
    Set ws = Sheet1
    Set ws2 = Sheet2
    wsr = ws.Range(Cells(1, 3), Cells(5000, 3))
    wsr2 = ws.Range(Cells(1, 5), Cells(5000, 5))
  
    For i = 2 To 5000
        If (wsr(i, 1))="" Then
            Exit For
        End If
    For j = 2 To 5000
        If (wsr2(j, 1))="" Then
            Exit For
        End If
If wsr(i, 1) = wsr2(i, 1) Then
    If ws.Range("B" & i).Value = "" Then
        ws.Range("B" & i).Value = wsr(j, 1) & "-" & wsr2(j, 1)
    Exit For
End If
    End If
    Next j
    Next i
End If

End Sub

i'm not getting any results with this example.

 

[Fluff]

Are you changing 1 cell at a time, or pasting into a number of cells?

 

[BRB1983]

Are you changing 1 cell at a time, or pasting into a number of cells?

one cell at a time. column c

 

[Fluff]

OK, untested, but try

Sub Worksheet_Change(ByVal Target As Range)
    Dim fnd As Range
    
    If Target.CountLarge > 1 Then Exit Sub
    If Not Application.Intersect(Target, Range("C2:C50")) Is Nothing Then
        If Target = "" And Target.Offset(, -1) <> "" Then Exit Sub
            With Sheet2
                Set fnd = .Range("E2:E5000").Find(Target.Value, , , xlWhole, , , False, , False)
            End With
            If fnd Is Nothing Then
                MsgBox Target.Value & " Not found"
                Exit Sub
            End If
            Target.Offset(, -1).Value = fnd.Value & "-" & fnd.Offset(, -3).Value
        End If
    End If
End Sub

 

[BRB1983]

Fluff,
post 15 didn't populate the answer but with minor modification it works perfectly. thanks a bunch. it does exactly what i want it to do.

Sub Worksheet_Change(ByVal Target As Range)
    Dim fnd As Range
    
    If Target.CountLarge > 1 Then Exit Sub
    If Not Application.Intersect(Target, Range("C2:C50")) Is Nothing Then
        If Target = "" Then Exit Sub
            With Sheet2
                Set fnd = .Range("E2:E5000").Find(Target.Value, , , xlWhole, , , False, , False)
            End With
            If fnd Is Nothing Then
                MsgBox Target.Value & " Not found"
                Exit Sub
            Else
            Target.Offset(, -1).Value = fnd.Value & "-" & fnd.Offset(, -3).Value
        End If
    End If

End Sub

 

[Fluff]

Glad you got it to work & thanks for the feedback

 

[offthelip]

try changing these two lines:

   wsr = ws.Range(Cells(1, 3), Cells(5000, 3))
   wsr2 = ws.Range(Cells(1, 5), Cells(5000, 5))

to :

    With Worksheets("Sheet1")
    wsr = Range(.Cells(1, 3), .Cells(5000, 3))
    End With
    With Worksheets("Sheet2")
    wsr2 = Range(.Cells(1, 5), .Cells(5000, 5))
    End With