Worksheet_Change with Select Case and copy / paste or autofill

fess67

New Member
Joined
Jan 13, 2015
Messages
1
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.

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
 

Some videos you may like

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.

Takae

Well-known Member
Joined
Jul 1, 2015
Messages
718
Isn't the "selection" of the code "Rng"? It loops each cell in first "For each" but next line's If statement checks "selection"

VBA Code:
If IsEmpty(<<Selection>>.Offset(0, 11)) Then

result = Application.VLookup(<<Selection>>.Offset(0, 11).Value,

Sheets("Tracking").Range("B" & LastRow) = <<Selection>>.Offset(0, 11).Value
 

Watch MrExcel Video

Forum statistics

Threads
1,122,472
Messages
5,596,354
Members
414,060
Latest member
hermanseck

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
Top