Copy from one sheet to another based on data in cell AV

[jimmisavage]

Good morning all,
I seem to have stumped myself on a bit of VBA coding and was hoping someone might fancy a challenge!

I have a tab call 'MasterSheet' which is fed by a userform. I need to be able to transfer snippets of rows into different sheets; which my formulas run off.

In MasterSheet, cell AV there will be an input of either "Breakfast" "lunch" "Dinner" or "Snack". The same options are also in Cell AW with the inclusion of " " (because some food might be used for breakfast or snack for instance).

So I will need a macro that will copy some of that row to another sheet and some other cells in that row to another sheet again. Lets start with Snacks.

When "Snack" is entered in either row AV or AW i need the macro to copy columns A:U of that row into a sheet called "SnacksSheet". I then need to copy rows A & V:AA from "MasterSheet" to a sheet called "Snacks" (in both instances I would like to populate column A onwards so there are no black cells (such as B-U).

I need a macro that will do this to all food groups (Breakfast, Lunch, Dinner and Snacks - sheet naming conventions are the same), but not to duplicate (so maybe we need an indicator in call AX to show its already moved that line?). Ideally this would run straight after the macro I used to populate from the userform.

Oh heck, I hope this makes some sense!

Thanks in advance
Stuart

 

[mumps]

You are correct when you say

we need an indicator in call AX to show its already moved that line

Each row in the MasterSheet must have a unique identifier that can be used to track where that row has been copied. You have to decide what that unique identifier looks like and in which column it will reside.

 

[jimmisavage]

I was thinking the macro could just populate cell AX with an 'x' or something similar once it's copied the data - then that criteria could be included in the code to ignore lines that have an 'x' in cell AX when running again?

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab for your MasterSheet and click 'View Code'. Paste the macro into the empty code window that opens up. Make sure the sheet names referenced in the code match your actual sheet names. Close the code window to return to your sheet. Make an entry in column AV or AW and exit the cell and the data will be copied automatically to the appropriate sheets. I'm not sure what you mean when you say

The same options are also in Cell AW with the inclusion of " " (because some food might be used for breakfast or snack for instance).

Give this a try and see how it works for you.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("AV:AV,AW:AW")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Select Case Target.Value
        Case "Breakfast"
            If Range("AX" & Target.Row) <> "x" Then
                Range("AX" & Target.Row) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("BreakfastSheet").Cells(Sheets("BreakfastSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
                Range("A" & Target.Row).Copy Sheets("Breakfast").Cells(Sheets("Breakfast").Rows.Count, "A").End(xlUp).Offset(1, 0)
                Range("V" & Target.Row & ":AA" & Target.Row).Copy Sheets("Breakfast").Cells(Sheets("Breakfast").Rows.Count, "B").End(xlUp).Offset(1, 0)
            Else
                MsgBox ("This row has already been copied.")
            End If
        Case "Lunch"
            If Range("AX" & Target.Row) <> "x" Then
                Range("AX" & Target.Row) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("LunchSheet").Cells(Sheets("LunchSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
                Range("A" & Target.Row).Copy Sheets("Lunch").Cells(Sheets("Lunch").Rows.Count, "A").End(xlUp).Offset(1, 0)
                Range("V" & Target.Row & ":AA" & Target.Row).Copy Sheets("Lunch").Cells(Sheets("Lunch").Rows.Count, "B").End(xlUp).Offset(1, 0)
            Else
                MsgBox ("This row has already been copied.")
            End If
        Case "Dinner"
            If Range("AX" & Target.Row) <> "x" Then
                Range("AX" & Target.Row) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("DinnerSheet").Cells(Sheets("DinnerSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
                Range("A" & Target.Row).Copy Sheets("Dinner").Cells(Sheets("Dinner").Rows.Count, "A").End(xlUp).Offset(1, 0)
                Range("V" & Target.Row & ":AA" & Target.Row).Copy Sheets("Dinner").Cells(Sheets("Dinner").Rows.Count, "B").End(xlUp).Offset(1, 0)
            Else
                MsgBox ("This row has already been copied.")
            End If
        Case "Snack"
            If Range("AX" & Target.Row) <> "x" Then
                Range("AX" & Target.Row) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy Sheets("SnackSheet").Cells(Sheets("SnackSheet").Rows.Count, "A").End(xlUp).Offset(1, 0)
                Range("A" & Target.Row).Copy Sheets("Snack").Cells(Sheets("Snack").Rows.Count, "A").End(xlUp).Offset(1, 0)
                Range("V" & Target.Row & ":AA" & Target.Row).Copy Sheets("Snack").Cells(Sheets("Snack").Rows.Count, "B").End(xlUp).Offset(1, 0)
            Else
                MsgBox ("This row has already been copied.")
            End If
    Application.ScreenUpdating = True
End Sub

 

[Joe4]

Cross-posted: https://www.excelforum.com/excel-pr...paste-between-sheets-based-on-cell-value.html

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here: http://www.mrexcel.com/forum/board-announcements/99490-forum-rules.html).

This way, other members can see what has already been done in regard to a question, and do not waste time working on a question that may already be answered.

For a more complete explanation on cross-posting, see here: http://www.excelguru.ca/content.php?184).

 

[jimmisavage]

Firstly, I apologise for cross-posting. I hadn't realised these were linked sites. I'll be sure to keep a track in this in the future.

mumps, thanks for the post. I have tried your code (I just needed to change snack to snacks) but unfortunately i'm getting a compile error: select case without end select when i make changes. Also, i'm wondering if this will actually even work because the data is entered via a userform?

many thanks
Stuart

 

[jimmisavage]

Okay, I realised it needed an End Select - which I've put towards the end of the code

            End If            End Select
    Application.ScreenUpdating = True
End Sub

But now it doesn't seem to copy to the sheets. It doesn't seem to do anything when i manually enter date or when data is entered via the userform

 

[jimmisavage]

My bad, it does work now I've added the End Select - however I a small problem...
It only works with either AV or AW. I would like it to add the line to the lunch sheet if 'lunch' is in AV and to the Snacks sheet if 'Snack' is in AW. At the moment it will only add from AV or AW if there is nothing in AV.

 

[Joe4]

Firstly, I apologise for cross-posting. I hadn't realised these were linked sites. I'll be sure to keep a track in this in the future.

The sites are NOT linked, but many people have accounts on multiple forums.
If you read the two links I provided in my post, you will see why Cross-Posting without references is a problem. It is really about showing courtesy and respect for other's time, especially when they are trying to help you for free.

 

[jimmisavage]

Thanks Joe4, fully understood. I absolutely appreciate and respect other people help and time.