Hi, I have reached my limit so need a bit of guidance on this one.
My code listens to a sheet and looks up an order number. If the order number is found then it adds a date based on the Case statement. If the order number is not found it adds to the tracking sheet and inserts the date as per the other Case statement. There is probably a better way rather than writing the case statements twice however what I need help with is when the user chooses to drag down or copy and paste the status rather than updating each row individually. Also my error handling is there just to ignore the error while I find a solution.
He will often does 30 or 40 rows at once so it makes sense for him to copy paste the status.
The code runs fine if only one at a time is changed. How should it be amended to run on multiple changes? Thanks in advance.
My code listens to a sheet and looks up an order number. If the order number is found then it adds a date based on the Case statement. If the order number is not found it adds to the tracking sheet and inserts the date as per the other Case statement. There is probably a better way rather than writing the case statements twice however what I need help with is when the user chooses to drag down or copy and paste the status rather than updating each row individually. Also my error handling is there just to ignore the error while I find a solution.
He will often does 30 or 40 rows at once so it makes sense for him to copy paste the status.
The code runs fine if only one at a time is changed. How should it be amended to run on multiple changes? Thanks in advance.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim StatusRng As Range
Dim Rng As Range
Dim LastRow As Long, CurrRow As Long
Dim ws As Worksheet
On Error Resume Next
Set ws = Worksheets("Tracking")
Application.EnableEvents = True
Set StatusRng = Intersect(Application.ActiveSheet.Range("B3:B5000"), Target)
LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
If Not StatusRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In StatusRng
If Not VBA.IsEmpty(Rng.Value) Then
'check if the production order is empty. If it is then exit the routine
If IsEmpty(Selection.Offset(0, 11)) Then
Application.EnableEvents = True
Exit Sub
Else
'check to see if the production order already exists in the Tracking sheet
result = Application.VLookup(Selection.Offset(0, 11).Value, Sheets("Tracking").Range("B2:B5000"), 1, False)
'if this is a new record then write to the Tracking sheet
If IsError(result) Then
Sheets("Tracking").Range("B" & LastRow) = Selection.Offset(0, 11).Value
CurrRow = LastRow
Select Case Rng.Value
Case "Materials"
ws.Range("C" & CurrRow) = Date
Case "Upcoming"
ws.Range("D" & CurrRow) = Date
Case "Ready"
ws.Range("E" & CurrRow) = Date
Case "Scheduled"
ws.Range("F" & CurrRow) = Date
Case "In Production"
ws.Range("G" & CurrRow) = Date
Case "Finished"
ws.Range("H" & CurrRow) = Date
Case "3rd Party"
ws.Range("I" & CurrRow) = Date
Case "Engineering"
ws.Range("J" & CurrRow) = Date
Case "Cancelled"
ws.Range("K" & CurrRow) = Date
Case "Hold"
ws.Range("L" & CurrRow) = Date
End Select
ws.Range("A" & LastRow) = LastRow
Else
'Apend the existing record with the updated status
CurrRow = Application.WorksheetFunction.Match(result, ws.Range("B:B"), 0)
Select Case Rng.Value
Case "Materials"
ws.Range("C" & CurrRow) = Date
Case "Upcoming"
ws.Range("D" & CurrRow) = Date
Case "Ready"
ws.Range("E" & CurrRow) = Date
Case "Scheduled"
ws.Range("F" & CurrRow) = Date
Case "In Production"
ws.Range("G" & CurrRow) = Date
Case "Finished"
ws.Range("H" & CurrRow) = Date
Case "3rd Party"
ws.Range("I" & CurrRow) = Date
Case "Engineering"
ws.Range("J" & CurrRow) = Date
Case "Cancelled"
ws.Range("K" & CurrRow) = Date
Case "Hold"
ws.Range("L" & CurrRow) = Date
End Select
End If
End If
End If
Next
Application.EnableEvents = True
End If
End Sub
