Compare Value in Cell to Sheet name before doing anything!

Jtlinx

New Member
Joined
Jul 1, 2014
Messages
14
Hello all,

I have individual sheets in a workbook named for each Shipping Agent at my workplace. In these sheets they log their parcel counts as they ship an order. They must (it's a required field) select their name from a drop-down list in column J:J so that another sheet can calculate their totals for week/month/year etc,,,. That's the backstory..

My question is... Sometimes they must log some of the shipment cases for another Agent that originally started the order and they then finished... thus, selecting that Agent's name from the drop-down. I scoured the internet, here included, and found VBA Code that will, when column J:J is changed, move the whole Row to that Agents Sheet that was picked from the drop down. What I need the code to do BEFORE it does that, is compare the name the Agent selected from the drop-down list in column J:J to the their name on the Worksheet. If they're the same, meaning the Agent is entering their own data in DO NOTHING. If they're not, meaning the Agent is entering another Agents data, then move the whole row, not going past Column J:J, to the last row of corresponding Agents sheet. (Which, again, it is currently doing that last part correctly...it's just doing it for every entry at present.)

I know this isn't the correct way to do this...but couldn't find how.. but here's my current code:

If Not Intersect(Target, Range("J:J")) Is Nothing Then
Application.EnableEvents = False
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
Dim r As Long
Dim Lastrow As Long
Dim ans As String
ans = Target.Value
r = Target.Row
Lastrow = Sheets(ans).Cells(Rows.Count, "J").End(xlUp).Row + 1
Rows(r).Copy Sheets(ans).Rows(Lastrow)
Rows(r).Delete
MsgBox "Row Moved"
End If
Application.EnableEvents = True

Windows 7 Pro 64bit
Excel 2013 (yeah I know it's old.. but hey...it was free)
not sure what else is needed here
but everything else is up-to-date!

Thanks in advance for any and all help!!!!

J.T.
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
This script you showed looks like one I wrote.
Try this new script.

If the Name entered in column J is the same name as the active sheet nothing will happen.
The rest of the script works the same.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  6/27/2019  11:18:00 PM  EDT
If Not Intersect(Target, Range("J:J")) Is Nothing Then
On Error GoTo M
Application.EnableEvents = False
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
Dim r As Long
Dim SN As String
SN = ActiveSheet.Name
Dim Lastrow As Long
Dim ans As String
ans = Target.Value
    If SN = ans Then
        Application.EnableEvents = True
        Exit Sub
    End If
r = Target.Row
Lastrow = Sheets(ans).Cells(Rows.Count, "J").End(xlUp).Row + 1
Rows(r).Copy Sheets(ans).Rows(Lastrow)
Rows(r).Delete
MsgBox "Row Moved"
End If
Application.EnableEvents = True
Exit Sub
M:
Application.EnableEvents = True
MsgBox "The sheet named  " & ans & "  Does Not Exist"
End Sub
 
Upvote 0
HI MAiT...

I'm not going to lie.. It MAY BE YOUR SCRIPT...LoL.. I can't remeber the page I got it from.. Like I said... I DuckDuckGo what I'm trying to accomplish and Cut-n-Paste a bunch of code that looks close, and then jigger with it in my limited knowledge to make it work...!! I just couldn't get it to look at the Sheet name.

It works beautifully btw... You made it look so simple and I hope to learn from what you did!!! Thank you Thank you Thank you so much..!!! Tell me how to mark this as an answer so that you get the most Kudos points or whatever it is that helps everyone here....lol.

I have another question tweaking this code further if you're up for another challenge? (and no, i'm not trying to get you to right my whole code)

If not, I understand...and most certainly appreciate the help already given!

Regards,
J.T.
 
Upvote 0
I'm sure I wrote the previous code and glad you used it.

So tell me what is your next need.
I always like a challenge.

Please be specific with sheet names and other information.

The best way to get quick answers is to be very specific.

Do not say column Date or the other Sheet these type terms are not specific.

Say something like sheet named Alpha column(3)

So now tell me what you need. And I will see what I can do.
 
Upvote 0
Ok..I'll try to be a specific as I can..

So, we compared the Agents name selected in the drop-down list in column J to the current Agent's Sheet Name... And IF THEY DIDN'T MATCH, we moved the whole row (out to column J) to the selected Agent's Sheet, and then deleted it from current Agent's sheet.

So what if instead, we didn't delete the record from the current Agent's sheet.....but backed up to column F and then ClearContents of columns F thru J of the record, so that the current Agent could then enter their case count for the same Order number, selecting their name this time around and the code letting it through as you wrote it last time? I say ClearContents only because I don't want the Agent name Drop-Down list in Column J to be blown away so the current agent could select their own name for calculation purposes on another sheet.

And by WE...I mean YOU...LoL... the last code worked perfectly!

I hope that's precise enough!!!

Thanks again for everything!

J.T.
 
Upvote 0
Assuming you want cells in columns F to J cleared instead of row deleted.
Try this:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  6/28/2019  12:54:51 AM  EDT
If Not Intersect(Target, Range("J:J")) Is Nothing Then
On Error GoTo M
Application.EnableEvents = False
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
Dim r As Long
Dim SN As String
SN = ActiveSheet.Name
Dim Lastrow As Long
Dim ans As String
ans = Target.Value
    If SN = ans Then
        Application.EnableEvents = True
        Exit Sub
    End If
r = Target.Row
Lastrow = Sheets(ans).Cells(Rows.Count, "J").End(xlUp).Row + 1
Rows(r).Copy Sheets(ans).Rows(Lastrow)
Cells(r, "F").Resize(, 5).ClearContents
MsgBox "Cells cleared"
End If
Application.EnableEvents = True
Exit Sub
M:
Application.EnableEvents = True
MsgBox "The sheet named  " & ans & "  Does Not Exist"
End Sub
 
Last edited:
Upvote 0
Works like a charm friend! Thank you so much!!!

BTW...I think I got the initial script from Excel Forums.com... Which is very similar to this site...LoL...

Anyway..! Thanks again friend! Hopefully I won't have to call on you too much in the future....!!!

J.T. Hardin
 
Upvote 0
Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.
Works like a charm friend! Thank you so much!!!

BTW...I think I got the initial script from Excel Forums.com... Which is very similar to this site...LoL...

Anyway..! Thanks again friend! Hopefully I won't have to call on you too much in the future....!!!

J.T. Hardin
 
Upvote 0

Forum statistics

Threads
1,223,893
Messages
6,175,241
Members
452,622
Latest member
Laura_PinksBTHFT

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
Back
Top