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

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.

igold

Well-known Member
Joined
Jul 8, 2014
Messages
2,695
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
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
 

dualwieldbacon

New Member
Joined
May 11, 2021
Messages
8
Office Version
  1. 2016
Platform
  1. Windows
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'?
 

igold

Well-known Member
Joined
Jul 8, 2014
Messages
2,695
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
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
 

dualwieldbacon

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

ADVERTISEMENT

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.
 

igold

Well-known Member
Joined
Jul 8, 2014
Messages
2,695
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
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.
 

igold

Well-known Member
Joined
Jul 8, 2014
Messages
2,695
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
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
 

dualwieldbacon

New Member
Joined
May 11, 2021
Messages
8
Office Version
  1. 2016
Platform
  1. Windows
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!
 

igold

Well-known Member
Joined
Jul 8, 2014
Messages
2,695
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
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.
 

Forum statistics

Threads
1,143,687
Messages
5,720,298
Members
422,275
Latest member
Maria95

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
Top