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

[Gafftape]

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 Requested

Quantity

Priority

Order Status

Lead Time / Expected city

Detailed Description of item

Other Notes

<tbody>
</tbody>

4/10/2019

5

ASAP

Received

2 weeks

widgets

Notes

<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!

 

[vcoolio]

Hello Gafftape,

You're welcome. I'm glad to have been able to assist you and thanks for the feed-back.

As for the safety net, we could introduce a message box warning to ensure that only "Received" is selected for data transfer:-

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
       [COLOR=#ff0000] If Target.Value <> "Received" Then
        MsgBox "If you are trying to transfer data to a destination sheet, then please" & vbNewLine & _
        "ensure that you only select 'Received' from the drop down. If not, then carry on.", vbExclamation, "WARNING"[/COLOR]
        
        ElseIf 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 parts in red font will bring up the message box ensuring that only "Received" is selected.

If the message box becomes annoying after a while, we could do it this way:-

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
              [COLOR=#ff0000]ElseIf Target.Value <> "Received" Then Exit Sub[/COLOR]
              End If
        End If

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

The part in red font in the second code above means that if "Received" is not selected then the sub is exited and no transfer of data will happen. However, it will allow you to carry on with the selected criteria (e.g. "Shipped") should you require to fill in a row whilst awaiting for the right time to select "Received".

Again, test the above in a copy of your actual workbook.

I hope that this further assists you.

Cheerio,
vcoolio.