Worksheet_change event with select case and copy paste or autofill

fess67 · Jan 5th 2021

Hi, I have reached the limit of my ability on this one. My code checks for an order number and if it exists updates a tracking sheet with todays date. If the order number does not exist it creates a record on the tracking sheet and records todays date in the relevant status code. Works great for single instances however the user needs to be able to copy and paste a batch of statuses at once and the code is not running in that instance.

I am sure the select case can be written better however that is not the primary concern at the moment. Also, the error handling is there just to prevent error messages until I can sort out the functionality.

Can you please help me fire the Select Case when the change event is a copy & paste or even an autofill drag.

Thanks in advance.

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

Display More

**royUK** · Jan 6th 2021

You should not use error handlers until you know what is happening with the code. Error handlers will suppress errors which might help solve the issue.

Which sheet is StatusRng on? Is it a different sheet to the one with code in?

Nothing is selected in the code so what is VLOOKUP looking for?

Is the order number a constant or generated by a formula?

Application.VLookup would need to be Application.WorkSheetFunction.VLookup, but I would use COUNTIF instead.

I've tried to understand your code but without seeing the workbook it's difficult to understand what sheets you are using. Attach an example of the workbook

fess67 · Jan 6th 2021

Thanks for taking the time to look Roy,

There are 2 sheets pertinent to the code. HTL and Tracking.

StatusRng is on the HTL sheet. The Tracking sheet is hidden and will not be used in everyday work, it is trying to capture dates of events to build up a timeframe of work passing though the facility.

Vlookup is taking the selected cell in StatusRng and looking across to pick up the order number. In the attached, simplified workbook, that is col C.

The order number is a constant allocated by the sales team. On occasion there will be no order number and these should be ignored which is why I put in the If IsEmpty statement.

I have attached a cut down workbook. When a status is applied in the HTL sheet the code does the following:

Check if order number exists - if no then exit
If order number exists then check Tracking sheet for that order number
If order number does not exist on Tracking sheet, write to new row and enter date in relevant status column
If order number does exist on Tracking sheet, find row and enter date in relevant status column.

Works fine on single changes however not on copy / paste of several rows. So if the user wants to change 10 rows to a status of Production he is changing the first one then copying that status and pasting to the remaining rows. That throws a type mismatch error on Ln73 of the code which is between the two Case statements.

CurrRow = Application.WorksheetFunction.Match(result, ws.Range("B:B"), 0)

In order to get things working again I need to stop the debugger and in the immediate window run Application.EnableEvents = True

Cheers,

Worksheet_change event with select case and copy paste or autofill

Participate now!

Share

Tags