Copy entire row to new tab if a cell contains certain text

[TShaq]

Hello,

Apologies in advance and please excuse me if I've broken any rules with this post (it is my first) and I will ensure it doesn't happen again.

I've been trying to get a few different macros to work that copy an entire row and move it to an existing tab. The workbook is a 'To Do List' and contains the following tabs 'Level Exc', 'Level 1', '1 Week Window', 'Sam', 'Level 2', 'Level 3', 'Master List', and 'ABC=Success'. The idea is that when I add a new task to the Master List worksheet (this would include information entered in a row in cell's A-F) the macro would copy over the entire row based on what is entered in column F to another worksheet (listed above). What is entered in Column F can only be Level Exc, Level 1, Level 2, 1 Week Window, Sam, Level 2, and Level 3 (these are the priority levels). Example, I open up the workbook, go to the 'Master List' worksheet, and I enter: "Take out the Trash" in Cell A2, "Don't forget to replace the bag" in cell B2, "TShaq" (owner of task) in cell C2, "Waiting on garbageman to pick up" (status) in cell D2, "3/14/2017" (date of completion) in cell E2, and finally "Level 1" in cell F2. The entire row is then copied to the worksheet 'Level 1' in the same workbook. Further note, the ABC=Success worksheet would ideally have the row copied over if I put a check mark in Column G (not terribly worried about this right now). The below is what I've tried to start working with, but it's getting a little beyond my ability and was wondering if someone might be able to help? The below could be totally wrong, it's been a longggg time since I've built a macro on my own.


Sub ToDoMove()
Dim strArray As Variant
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim NoRows As Long
Dim DestNoRows As Long
Dim I As Long
Dim J As Integer
Dim rngCells As Range
Dim rngFind As Range
Dim Found As Boolean

strArray = Array("Level Exc", "Level 1", "1 Week Window", "Sam", "Level 2", "Level 3")

Set wsSource = ActiveSheet

NoRows = wsSource.Range("A65536").End(xlUp).Row
DestNoRows = 1
Set wsDest = ActiveWorkbook.Worksheets.Add

For I = 1 To NoRows

Set rngCells = wsSource.Range("A" & G & ":A" & G)
Found = False
For J = 0 To UBound(strArray)
Found = Found Or Not (rngCells.Find(strArray(J)) Is Nothing)
Next J

If Found Then
rngCells.EntireRow.Copy wsDest.Range("A" & DestNoRows)

DestNoRows = DestNoRows + 1
End If
Next I
End Sub



Thanks!

TShaq

[mdmackillop]

Hi
I you can Post a workbook (http://www.vbaexpress.com/forum/faq.php?s=&do=search&q=attachment&titleandtext=1&match=all) showing expected outcome that makes life easier. I've added Code tags using the # button to your code.

[TShaq]

Hey,

Thanks for the advice (and the code tags) will remember that in the future. For some reason when I try and 'Add File' and upload it doesn't show up in the window, so I can't drag and drop it into the add attachment area. Maybe it's because I'm at work, but will try when I get home this evening.

Thanks!

TShaq

[TShaq]

Here is the excel file. On the Master List Worksheet you will see the populated row which you will also see on the Level 1 worksheet based on the Category on the Master List. As I add to the Master List worksheet I will populate the category with one of the worksheet names (Level Exc, Level 1, etc.) and would like the row to be copied over to the worksheet with the same category name. Hope this helps and thanks again!

TShaq

18637

[mdmackillop]

Give this a try.
I've added data validation to Category and the macro is Event driven. Changing the caterory will copy the data. Similarly entering data in column G will transfer the row to the Success sheet.

Refer to Post#8 for correct file

[TShaq]

Hmmmm, I can't seem to get it to work when entering new data? Doesn't look like there is any code in VB? Maybe I'm missing something?

Thanks!

TShaq

[mdmackillop]

The Event code in the Object modules
ThisWorkbook

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Select Case Sh.Name
Case "Master List", "ABC=Success"
'do nothing
Case Else
If Target.Column = 7 And Target <> "" Then
Set Tgt = Sheets("ABC=Success").Cells(Rows.Count, 1).End(xlUp)(2)
Sh.Cells(Target.Row, 1).Resize(, 7).Copy Tgt
End If
End Select
End Sub

Sheet 7

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Exits
Application.EnableEvents = False
If Target.Column = 6 And Target <> "" Then CopyData
Exits:
Application.EnableEvents = True
End Sub


The Copy code is in Module 1

Sub CopyData()
Dim Sh As Worksheet
Dim Tgt As Range
Set Sh = Sheets("Master List")
With Sh
Set Tgt = Sheets(.Range("F2").Value).Cells(Rows.Count, 1).End(xlUp)(2)
Application.Goto Tgt
.Range("A2:G2").Copy Tgt
'.Range("A2:G2").ClearContents

End With
End Sub

[mdmackillop]

Apologies
I attached the wrong file

[TShaq]

That's awesome! Really appreciate it! The one thing that doesn't seem to be working is that when I add a new task below the one on the Master List it spits it out onto Level 3? Looks like the macro only looks to the 2nd row and not newly entered data? Could be doing something wrong.

Thanks!

TShaq

[mdmackillop]

I wasn't sure on your data entry and assumed overwriting of Row 2

Minor changes

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Exits
Application.EnableEvents = False
If Target.Column = 6 And Target <> "" Then Call CopyData(Target)
Exits:
Application.EnableEvents = True
End Sub


and

Sub CopyData(Target)
Dim Sh As Worksheet
Dim Tgt As Range
Set Sh = Sheets("Master List")
With Sh
Set Tgt = Sheets(.Range("F2").Value).Cells(Rows.Count, 1).End(xlUp)(2)
'Application.Goto Tgt
.Cells(Target.Row, 1).Resize(, 7).Copy Tgt
End With
End Sub

[TShaq]

I can utilize the 1st one for sure and just manipulate the way I'm entering data. The updated code (above) seems to automatically reference the 1st row (Level 1) and even if it's Level 3 it defaults it to Level 1. Don't want to take up any more of your time. This is great and is very very much appreciated!

Thanks!

TShaq

[mdmackillop]

Just retired so plenty time (and I like to get things right)
Copy confirmation line added as well.

[TShaq]

Awesome, let me give it a shot!

[TShaq]

This is perfect! Nailed it! You've totally made my day!

TShaq