Moving data from one sheet to another, based on Cell value

Gafftape

New Member
Joined
Apr 10, 2019
Messages
6
Hello there,

I'm trying to adapt some code that i found in another thread.
Sub MM2()
Dim lr As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
With ActiveSheet.Rows("1:" & lr)
.AutoFilter
.AutoFilter Field:=5, Criteria1:="Yes", Operator:=xlAnd
.SpecialCells(xlCellTypeVisible).EntireRow.Cut Destination:=Sheets("Sheet2").Range("A" & Sheets("Sheet2").UsedRange.Rows.Count + 1)
.Autofilter
End With
End Sub


I'm very new to VBA and have gotten a General knowledge of this stuff over the last weeks but i'm definitely missing a fair amount of what you'd consider Basic Knowledge. As such the above code may not actually be what i need.

What i'm trying to accomplish:
The workbook that i'm creating will be used to track orders being made offsite and being fulfilled by our home office.
It has 9 sheets.
Instructions, Dept1, Dept2, Dept3, Dept4, Received Dept1, Received Dept2, Received Dept3, Received Dept4
The 1st is just instructions / examples of the layout of the preceding sheets. It will be locked from accepting User changes

The all the sheets are laid out with the top 5 rows being information for the users.
The 6th row is a header row for a table, 7th row starts data entry. "Date Requested" is in column A
Date RequestedQuantityPriorityOrder StatusLead Time / Expected cityDetailed Description of itemOther Notes

<tbody>
</tbody>
4/10/20195ASAPReceived2 weekswidgetsNotes

<tbody>
</tbody>

Order Status has data validation with 4 option in a drop down list.
My goal is for there to be a button that moves a row that is marked as "Received" in a "Dept*" sheet to the corresponding "Received Dept*" sheet.
I don't know if it's necessary, but i might need a another button on the "Received Dept*" sheets to undo a move that was done in error.

When a "Dept*" sheet has a row removed from it i would like for the table to stay the same length,
I believe this would be done by Copying then Clearing a row vs. cutting. Correct me if i'm wrong.

When a "Received Dept*" sheet has a row transferred to it I would like the row to be inserted at the top of the table.

I also don't know if this would be easier with with one global macro and buttons pointing to it or 4 separate macros tied to their respective pairs of sheets.

I've tried to be as complete as I can with this post but i'm sure I've forgotten something.

Thank you all for any help or advice you can give!
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
Hello Gafftape,

When a "Dept*" sheet has a row removed from it i would like for the table to stay the same length,
I believe this would be done by Copying then Clearing a row vs. cutting. Correct me if i'm wrong.

Is this important or necessary? This can be done by just clearing the contents of the row but you're going to end up with a number of empty rows in your data set which in turn will make the data set look very "patchy" (for want of a better word!).
Deleting the rows will move all data up and compress the data set for a far better look.

Let us know your thoughts.

Cheerio,
vcoolio.
 
Upvote 0
Is this important or necessary? This can be done by just clearing the contents of the row but you're going to end up with a number of empty rows in your data set which in turn will make the data set look very "patchy" (for want of a better word!).
Deleting the rows will move all data up and compress the data set for a far better look.

Ah, i hadn't thought about it like that. I was more worried about the table shrinking as rows are removed.
I'd be fine with deleting rows if i can maintain the table length.
 
Upvote 0
Hello Gafftape,


I'd be fine with deleting rows if i can maintain the table length.

This is not possible. Once a row is deleted, the one below will move up into its place so the table length will continually vary.
Why is this a concern for you? If you are using formal Excel tables theses will automatically adjust in length with the addition/deletion of data.

Perhaps you could upload a sample of your workbook to a file sharing site such as Drop Box or Box.com then place the link to your file back here. If your data is sensitive then please use dummy data. Make sure that your sample is an exact replica of your workbook.

Cheerio,
vcoolio.
 
Upvote 0
Hello Gafftape,

Just a few questions to confirm:-

- Is "Received" the only criteria in the drop downs in Column D that we need to be concerned with?
- Data from the source sheets needs to be transferred to the corresponding destination sheet which all begin with "Received" (e.g. from "Costumes" to "Received Costumes"). Correct?
- The relevant rows of data in the source sheets need to be deleted once transferred to the relevant destination sheet. Correct?
- Do the destination sheets actually need to be formatted as tables?

Cheerio,
vcoolio.
 
Upvote 0
Hello vcoolio,


- Is "Received" the only criteria in the drop downs in Column D that we need to be concerned with? -Correct

- Data from the source sheets needs to be transferred to the corresponding destination sheet which all begin with "Received" (e.g. from "Costumes" to "Received Costumes"). Correct? -Yes

- The relevant rows of data in the source sheets need to be deleted once transferred to the relevant destination sheet. Correct? -Yes

- Do the destination sheets actually need to be formatted as tables? -No


Thanks,
Gafftape

 
Upvote 0
Hello Gafftape,

See if the following code does the task for you:-


Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

        If Intersect(Target, Sh.Columns(4)) Is Nothing Then Exit Sub
        If Target.Count > 1 Then Exit Sub
        If Target = vbNullString Then Exit Sub

Application.ScreenUpdating = False

        If Sh.Name <> "Instructions" Then
        If Target.Value = "Received" Then
              Sheets(Target.Value & " " & Sh.Name).Rows("7:7").Insert
              Target.EntireRow.Copy
              Sheets(Target.Value & " " & Sh.Name).[A7].PasteSpecial xlValues
              Target.EntireRow.Delete
              End If
        End If

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

The code is a Workbook_SheetChange event code (no buttons required). The one code will work on all source sheets. Once you select "Received" from the drop downs in Column D of the source sheets, the relevant row of data will be instantly transferred to its relevant destination sheet. The row of data is then deleted from the source sheet. The criteria "Received" needs to be the very last entry per row.
The data is added to the top of the data set in the destination sheets.

To implement the code:-

- Right click on any sheet tab.
- Select "View Code" from the menu that appears.
- Double click on "ThisWorkbook" (over to the left in the Project Explorer).
- Paste the code into the big white code field that then appears.

Below is the link to your sample with the code implemented. In any source sheet, select "Received" from the drop downs in Column D to see how the code works:-

http://ge.tt./5ZuTZiv2

You'll note that I've removed the tables from the destination sheets but have left them in the source sheets.
I've also adjusted the sheet name "Received Technical Productions" to "Received Technical Production" so that the word "Production" matches the source sheet ("Technical Production"). This is important as you'll otherwise receive an error message.

Please test the code in a copy of your actual workbook first.

I hope that this helps.

Cheerio,
vcoolio.
 
Last edited:
Upvote 0
Actually Gafftape, use this link:-

http://ge.tt./9cMFbiv2

I think the fist link I supplied had the code implemented without the delete line of code.

Cheerio,
vcoolio.
 
Upvote 0
Awesome!
The code is in and working.
Good call on the table removal, i was able to create an error when the drop down menus were still there.

The part about the Button is kind of a safety net. If a user mistakenly selects "received" they'd be able to correct it before hitting the button to archive the order.


Thank you again for all the help you've given me on this.

-Gafftape
 
Upvote 0

Forum statistics

Threads
1,213,485
Messages
6,113,931
Members
448,533
Latest member
thietbibeboiwasaco

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