VBA Help - Trying to take data from a Master Sheet and copy rows based on specific column values

dualwieldbacon

New Member
Joined
May 11, 2021
Messages
8
Office Version
  1. 2016
Platform
  1. Windows
Hi all!

Very new to VBA here and I'm quite impressed with what it can do. I'm trying to set up a template and would like to automate as much as possible. In my master sheet, I have headings in the first row that spans columns A to W. Column V has two options for my data rows: 'Email' and 'Send'. When I input my data, I would like all rows that contain the trigger word 'Email' in Column V to be copied onto my sheet labelled 'Email List'. Similarly, I'd like the rows that contain the trigger word 'Mail' to be copied onto another third sheet called 'Send List'. In my master sheet, I also have a column W (called 'Assigned To') where I want to be able to enter either 'J' or 'A'; if it contains 'J' or 'A', I want that row to be copied onto a 4th sheet called 'Call List'.

I would like to retain all the data in my master sheet once it has been moved over to the appropriate sheet, so it does not get deleted. Any help is appreciated!
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Hi dualwieldbacon, welcome to the MrExcel forum.

Does this come close to what you want to do. Please note that every time you run this code it will clear out all sheets but "Master" and rebuild them.

VBA Code:
Sub CopyRows()

    Dim str As String
    Dim i As Long, x As Long, lRow As Long
    Dim wsM As Worksheet: Set wsM = Worksheets("Master")
    Dim wsE As Worksheet: Set wsE = Worksheets("Email List")
    Dim wsS  As Worksheet: Set wsS = Worksheets("Send List")
    Dim wsC As Worksheet: Set wsC = Worksheets("Call List")
    
    Application.ScreenUpdating = False
    
    wsE.Range("A2:W" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    wsS.Range("A2:W" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    wsC.Range("A2:W" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    For x = 21 To 23
        For i = 2 To wsM.Cells(Rows.Count, 1).End(xlUp).Row
            str = Cells(i, x)
            Select Case str
                Case Is = "Email"
                    wsM.Range("A" & i).EntireRow.Copy
                    lRow = wsE.Cells(Rows.Count, 1).End(xlUp).Row + 1
                    wsE.Range("A" & lRow).PasteSpecial xlPasteAll
                Case Is = "Mail"
                    wsM.Range("A" & i).EntireRow.Copy
                    lRow = wsS.Cells(Rows.Count, 1).End(xlUp).Row + 1
                    wsS.Range("A" & lRow).PasteSpecial xlPasteAll
            End Select
        Next
        Application.CutCopyMode = False
    Next

    For i = 2 To wsM.Cells(Rows.Count, 1).End(xlUp).Row
        str = Cells(i, 23)
        Select Case str
            Case Is = "J"
                wsM.Range("A" & i).EntireRow.Copy
                lRow = wsC.Cells(Rows.Count, 1).End(xlUp).Row + 1
                wsC.Range("A" & lRow).PasteSpecial xlPasteAll
            Case Is = "A"
                wsM.Range("A" & i).EntireRow.Copy
                lRow = wsC.Cells(Rows.Count, 1).End(xlUp).Row + 1
                wsC.Range("A" & lRow).PasteSpecial xlPasteAll
            End Select
        Application.CutCopyMode = False
    Next
    
    Application.ScreenUpdating = True
    
End Sub
 
Upvote 0
Hi dualwieldbacon, welcome to the MrExcel forum.

Does this come close to what you want to do. Please note that every time you run this code it will clear out all sheets but "Master" and rebuild them.

VBA Code:
Sub CopyRows()

    Dim str As String
    Dim i As Long, x As Long, lRow As Long
    Dim wsM As Worksheet: Set wsM = Worksheets("Master")
    Dim wsE As Worksheet: Set wsE = Worksheets("Email List")
    Dim wsS  As Worksheet: Set wsS = Worksheets("Send List")
    Dim wsC As Worksheet: Set wsC = Worksheets("Call List")
   
    Application.ScreenUpdating = False
   
    wsE.Range("A2:W" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    wsS.Range("A2:W" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    wsC.Range("A2:W" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    For x = 21 To 23
        For i = 2 To wsM.Cells(Rows.Count, 1).End(xlUp).Row
            str = Cells(i, x)
            Select Case str
                Case Is = "Email"
                    wsM.Range("A" & i).EntireRow.Copy
                    lRow = wsE.Cells(Rows.Count, 1).End(xlUp).Row + 1
                    wsE.Range("A" & lRow).PasteSpecial xlPasteAll
                Case Is = "Mail"
                    wsM.Range("A" & i).EntireRow.Copy
                    lRow = wsS.Cells(Rows.Count, 1).End(xlUp).Row + 1
                    wsS.Range("A" & lRow).PasteSpecial xlPasteAll
            End Select
        Next
        Application.CutCopyMode = False
    Next

    For i = 2 To wsM.Cells(Rows.Count, 1).End(xlUp).Row
        str = Cells(i, 23)
        Select Case str
            Case Is = "J"
                wsM.Range("A" & i).EntireRow.Copy
                lRow = wsC.Cells(Rows.Count, 1).End(xlUp).Row + 1
                wsC.Range("A" & lRow).PasteSpecial xlPasteAll
            Case Is = "A"
                wsM.Range("A" & i).EntireRow.Copy
                lRow = wsC.Cells(Rows.Count, 1).End(xlUp).Row + 1
                wsC.Range("A" & lRow).PasteSpecial xlPasteAll
            End Select
        Application.CutCopyMode = False
    Next
   
    Application.ScreenUpdating = True
   
End Sub

That works near perfectly, igold! Thank you so much!

One issue I'm having however is that when I note the rows in the Master sheet with 'J' or 'A' to assign it to the specific individual, I can see this column in both the 'Email List' and 'Send List' sheets. How can I have it so that it only appears in the 4th sheet 'Call List'?
 
Upvote 0
Is this better...

VBA Code:
Sub CopyRows()

    Dim str As String
    Dim i As Long, x As Long, lRow As Long
    Dim wsM As Worksheet: Set wsM = Worksheets("Master")
    Dim wsE As Worksheet: Set wsE = Worksheets("Email List")
    Dim wsS  As Worksheet: Set wsS = Worksheets("Send List")
    Dim wsC As Worksheet: Set wsC = Worksheets("Call List")
    
    Application.ScreenUpdating = False
    
    wsE.Range("A2:W" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    wsS.Range("A2:W" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    wsC.Range("A2:W" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    For x = 23 To 21 Step -1
        For i = 2 To wsM.Cells(Rows.Count, 1).End(xlUp).Row
            str = Cells(i, x)
            Select Case str
                Case Is = "J"
                    wsM.Range("A" & i).EntireRow.Copy
                    lRow = wsC.Cells(Rows.Count, 1).End(xlUp).Row + 1
                    wsC.Range("A" & lRow).PasteSpecial xlPasteAll
                Case Is = "A"
                    wsM.Range("A" & i).EntireRow.Copy
                    lRow = wsC.Cells(Rows.Count, 1).End(xlUp).Row + 1
                    wsC.Range("A" & lRow).PasteSpecial xlPasteAll
                Case Is = "Email"
                        If Cells(i, 23) = "J" Or Cells(i, 23) = "A" Then GoTo JA
                        wsM.Range("A" & i).EntireRow.Copy
                        lRow = wsE.Cells(Rows.Count, 1).End(xlUp).Row + 1
                    wsE.Range("A" & lRow).PasteSpecial xlPasteAll
                Case Is = "Mail"
                        If Cells(i, 23) = "J" Or Cells(i, 23) = "A" Then GoTo JA
                        wsM.Range("A" & i).EntireRow.Copy
                        lRow = wsS.Cells(Rows.Count, 1).End(xlUp).Row + 1
                        wsS.Range("A" & lRow).PasteSpecial xlPasteAll
JA:
            End Select
        Next
        Application.CutCopyMode = False
    Next
    Application.ScreenUpdating = True
    
End Sub
 
Upvote 0
Is this better...

VBA Code:
Sub CopyRows()

    Dim str As String
    Dim i As Long, x As Long, lRow As Long
    Dim wsM As Worksheet: Set wsM = Worksheets("Master")
    Dim wsE As Worksheet: Set wsE = Worksheets("Email List")
    Dim wsS  As Worksheet: Set wsS = Worksheets("Send List")
    Dim wsC As Worksheet: Set wsC = Worksheets("Call List")
   
    Application.ScreenUpdating = False
   
    wsE.Range("A2:W" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    wsS.Range("A2:W" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    wsC.Range("A2:W" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
    For x = 23 To 21 Step -1
        For i = 2 To wsM.Cells(Rows.Count, 1).End(xlUp).Row
            str = Cells(i, x)
            Select Case str
                Case Is = "J"
                    wsM.Range("A" & i).EntireRow.Copy
                    lRow = wsC.Cells(Rows.Count, 1).End(xlUp).Row + 1
                    wsC.Range("A" & lRow).PasteSpecial xlPasteAll
                Case Is = "A"
                    wsM.Range("A" & i).EntireRow.Copy
                    lRow = wsC.Cells(Rows.Count, 1).End(xlUp).Row + 1
                    wsC.Range("A" & lRow).PasteSpecial xlPasteAll
                Case Is = "Email"
                        If Cells(i, 23) = "J" Or Cells(i, 23) = "A" Then GoTo JA
                        wsM.Range("A" & i).EntireRow.Copy
                        lRow = wsE.Cells(Rows.Count, 1).End(xlUp).Row + 1
                    wsE.Range("A" & lRow).PasteSpecial xlPasteAll
                Case Is = "Mail"
                        If Cells(i, 23) = "J" Or Cells(i, 23) = "A" Then GoTo JA
                        wsM.Range("A" & i).EntireRow.Copy
                        lRow = wsS.Cells(Rows.Count, 1).End(xlUp).Row + 1
                        wsS.Range("A" & lRow).PasteSpecial xlPasteAll
JA:
            End Select
        Next
        Application.CutCopyMode = False
    Next
    Application.ScreenUpdating = True
   
End Sub

Hmmm, now it seems to only copy all the rows I've denoted as 'J' or 'A' into the 4th sheet, 'Call List'. The rows I've marked as 'Email' or 'Mail' do not show up in the 'Email List' or 'Send List' sheets.
 
Upvote 0
It did work perfectly for me as per your requirements. Are you sure that the data in the columns match exactly to what the code is looking for. If not change the code to what is in the columns. Can you post a small sample of your data.
 
Upvote 0
One issue I'm having however is that when I note the rows in the Master sheet with 'J' or 'A' to assign it to the specific individual, I can see this column in both the 'Email List' and 'Send List' sheets. How can I have it so that it only appears in the 4th sheet 'Call List'?
As per this statement in your Post #3, the template you uploaded has a "J" or an "A" in every line, therefore those lines only show on the Call List
 
Upvote 0
As per this statement in your Post #3, the template you uploaded has a "J" or an "A" in every line, therefore those lines only show on the Call List

I played around with the first code you shared and I was able to achieve just what I wanted! Turns out that hiding columns was an easy way to solve this. Thanks again, igold!
 
Upvote 0
You are welcome, I was happy to help. Thanks for the feedback.

When I looked at your template, I noticed you had the code placed in the Master Worksheet Module. You should move the code into the empty Module1 as mostly all code should be put into Code Modules (such as Module1) and not in Worksheet Modules.
 
Upvote 0

Forum statistics

Threads
1,213,549
Messages
6,114,261
Members
448,558
Latest member
aivin

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