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

 

[jimmisavage]

It's okay Joe,
I've solved my problem by making the cell references absolute.

Thanks for all your help!

 

[mumps]

Try:

Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("AB:AC")) 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 Target.Offset(0, 2) <> "x" Then
                Target.Offset(0, 2) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy
                Sheets("BreakfastSheet").Cells(Sheets("BreakfastSheet").Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Else
                MsgBox ("This row has already been copied.")
            End If
        Case "Lunch"
            If Target.Offset(0, 2) <> "x" Then
                Target.Offset(0, 2) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy
                Sheets("LunchSheet").Cells(Sheets("LunchSheet").Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Else
                MsgBox ("This row has already been copied.")
            End If
        Case "Dinner"
            If Target.Offset(0, 2) <> "x" Then
                Target.Offset(0, 2) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy
                Sheets("DinnerSheet").Cells(Sheets("DinnerSheet").Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Else
                MsgBox ("This row has already been copied.")
            End If
        Case "Snacks"
            If Target.Offset(0, 2) <> "x" Then
                Target.Offset(0, 2) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy
                Sheets("SnackssSheet").Cells(Sheets("SnackssSheet").Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Else
                MsgBox ("This row has already been copied.")
            End If
    End Select
    Application.ScreenUpdating = True
    End If
End Sub

 

[jimmisavage]

Try:

Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("AB:AC")) 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 Target.Offset(0, 2) <> "x" Then
                Target.Offset(0, 2) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy
                Sheets("BreakfastSheet").Cells(Sheets("BreakfastSheet").Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Else
                MsgBox ("This row has already been copied.")
            End If
        Case "Lunch"
            If Target.Offset(0, 2) <> "x" Then
                Target.Offset(0, 2) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy
                Sheets("LunchSheet").Cells(Sheets("LunchSheet").Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Else
                MsgBox ("This row has already been copied.")
            End If
        Case "Dinner"
            If Target.Offset(0, 2) <> "x" Then
                Target.Offset(0, 2) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy
                Sheets("DinnerSheet").Cells(Sheets("DinnerSheet").Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Else
                MsgBox ("This row has already been copied.")
            End If
        Case "Snacks"
            If Target.Offset(0, 2) <> "x" Then
                Target.Offset(0, 2) = "x"
                Range("A" & Target.Row & ":U" & Target.Row).Copy
                Sheets("SnackssSheet").Cells(Sheets("SnackssSheet").Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Else
                MsgBox ("This row has already been copied.")
            End If
    End Select
    Application.ScreenUpdating = True
    End If
End Sub

Hi mumps,
I tried your code but I have a small problem. The data that's being copied is 21 columns long, but sometimes only has a couple of columns of actual data.
When copying and pasting (as well as referencing cells like i was doing) seems to actually make all 21 cells active. This is causing me a problem when i'm trying to populate a list because it's showing the 'empty' cells in my list creating gaps. How would i tackle this issue?

 

[mumps]

What kind of list are you trying to populate?

 

[jimmisavage]

I'm populating a shopping list via a vba. From my Google search I believe I'm dealing with a zero-length string but i'm not sure how to fix this problem.

 

[jimmisavage]

Problem solved. I created a macro to run through each sheet and delete all cells with " "
It's working as expected now.

Thank you both for all the help!

 

[mumps]

Glad to help.