Help with altering a "copy/paste row" macro to include an "OTHER" category

[kterps]

Hello All!

I am working on an excel file for work, one that tracks the performance of the company and individual employees on specific jobs. The file has a master sheet, 1 sheets per employee of interest, and other sheets with relative unimportant functions in this context. Individual jobs are entered in the master sheet, and each entry has 3 general parts: (1) job details, not of concern in this context, (2) Scores on the job, and (3) employees that completed the job, 1 name per column, 10 columns possible.

From here, a macro checks part (3), and copy/pastes that entire row in the sheets of employees that worked that job. This depends on having 1 sheet per employee and their name entry = their sheet name. Then each sheet shows some cute stats.

What I would like is a way to catch employees not of interest (ENIs), just in case we'd need to reference it with ease. The first solution I had in mind was to create a button you press before activating the other macro that changes ENIs to read "OTHER". This is counterintuitive, however, as I wouldn't be able to see exactly who was on the job afterward!

Now I am wondering if it would be possible to change this macro to also copy/paste in a sheet named "OTHER" if someone without their own sheet worked that job? I am more than happy to answer questions and clarify! I thank you all in advance!

The current macro:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
Cancel = True
On Error GoTo M
Dim Lastrow As Long
For Each c In Range(Cells(Target.Row, 10), Cells(Target.Row, 19))
If c.Value <> "" Then
Lastrow = Sheets(c.Value).Cells(Rows.Count, "A").End(xlUp).Row + 1
Rows(Target.Row).Copy Destination:=Sheets(c.Value).Rows(Lastrow)

End If
Next
Target.Interior.ColorIndex = 4
Exit Sub
End If
M:
MsgBox "No such sheet exist"
End Sub

 

[Trevor_S]

Try putting the following instead of the message box:
Lastrow = Sheets("Other").Cells(Rows.Count, "A").End(xlUp).Row + 1
Rows(Target.Row).Copy Destination:=Sheets(" Other").Rows(Lastrow)

 

[kterps]

Thank you for replying! Sorry the weekend prevented me from getting to this email, out representing the ole Alma Mater!

I guess I forgot to mention I'm an excel dunce when it comes to VBA and macros. I figured you were referring to this bit:

M:MsgBox "No such sheet exist"

When this was replaced with what you provided, I received the following:

"Complie Error
Label not defined."

The thing is, I could have very well replace the wrong part or failed to remove all that is necessary. This was what I tried:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
Cancel = True
On Error GoTo M
Dim Lastrow As Long
For Each c In Range(Cells(Target.Row, 10), Cells(Target.Row, 19))
If c.Value <> "" Then
Lastrow = Sheets(c.Value).Cells(Rows.Count, "A").End(xlUp).Row + 1
Rows(Target.Row).Copy Destination:=Sheets(c.Value).Rows(Lastrow)

End If
Next
Target.Interior.ColorIndex = 4
Exit Sub
End If
Lastrow = Sheets("Other").Cells(Rows.Count, "A").End(xlUp).Row + 1
Rows(Target.Row).Copy Destination:=Sheets(" Other").Rows(Lastrow)
End Sub

Thanks again for the help!!

 

[Trevor_S]

You still need the M: because it is the label. You don't need the MsgBox "No such sheet exist", because it is replaced by my code.

The M: goes on a line on its own between the End If and Lastrow = ...

Earlier in the macro, you have a line that says On Error Goto M. So you need a marker (label) called M so it knows where to jump to.

Hope that works!

 

[kterps]

Trevor, thanks for all your help!

With your edit, the macro does exactly as I would like it to do!! Although it originally disabled the "fill cell" function (for whatever reason), I did enough VBA research online to begin interpreting what the code was doing and how different parts were interacting with each other and I gave the function back to the macro! :D (its the little victories that count, right?)

Thank you again for all your help Trevor!