Copy rows based on cell value to another worksheet

W

weavera

New Member
Joined
Sep 1, 2014
Messages
10
Hi There,

I am really struggling to get this working (Very new to <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-bottom-style: dotted; border-bottom-color: rgb(0, 0, 0); cursor: help; color: rgb(51, 51, 51); background-color: rgb(250, 250, 250);">VBA/macros</acronym>).

I am using excel 2010 on an XP 32bit laptop.

I am trying to create a macro to copy rows from one worksheet called "data" if the value in cell "K" = "1" or "2". I then need the copied data to be pasted into a worksheet called "Priority Tests Only".

If the value in Cell "K" is higher than 2 (3, 4 or 5) then copy and paste into another worksheet called "other Tests".

Cell "K" in the "data" sheet has a long excel code to perform the calculations required in order to deliver 1, 2, 3, 4 or 5.

Any help would be very much appreciated. Thanks in advance to anyone taking their time read this!
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sort by date Sort by votes
.
.

Place the following macro into a standard code module in your workbook.

I've made these assumptions regarding your "Data" sheet:
(1) The top row contains headings; and
(2) The data starts in column A.

Code: 
Sub CopyData()
    
    'For "Data" worksheet:
    Dim DSht As Worksheet
    Dim DCnt As Long
    Dim DRng As Range
    Dim DTop As Range
    
    'For "Priorty" worksheet:
    Dim PSht As Worksheet
    Dim PRow As Long
    
    'For "Other" worksheet:
    Dim OSht As Worksheet
    Dim ORow As Long
    
    'For looping:
    Dim Cell As Range
    
    'Set variables for worksheets
    With ThisWorkbook
        Set DSht = .Worksheets("Data")
        Set PSht = .Worksheets("Priority Tests Only")
        Set OSht = .Worksheets("Other Tests")
    End With
    
    'Get headings & no. of records
    'from "Data" sheet and set
    'range for looping in col. K...
    
    With DSht
        Set DTop = Range(.Range("A1"), .Range("A1").End(xlToRight))
        DCnt = .Cells(.Rows.Count, "K").End(xlUp).Row
        Set DRng = .Range("K2:K" & DCnt)
    End With
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    'Set headings in "Priority"
    'sheet and determine
    'next empty row...
    
    With PSht
        .Range("A1").Resize(ColumnSize:=DTop.Count).Value = DTop.Value
        PRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With
    
    'Set headings in "Other"
    'sheet and determine
    'next empty row...
    
    With OSht
        .Range("A1").Resize(ColumnSize:=DTop.Count).Value = DTop.Value
        ORow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With
    
    'Loop through cells in col. K
    'on "Data" sheets and paste
    'rows to other sheets
    'depending on cell value...
    
    For Each Cell In DRng
        Select Case Cell.Value
            Case Is = 1, 2:
                Cell.EntireRow.Copy
                PSht.Cells(PRow, "A").PasteSpecial _
                    Paste:=xlPasteValuesAndNumberFormats
                PRow = PRow + 1
            Case Is = 3, 4, 5:
                Cell.EntireRow.Copy
                OSht.Range("A" & ORow).PasteSpecial _
                    Paste:=xlPasteValuesAndNumberFormats
                ORow = ORow + 1
        End Select
    Next Cell
    
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    
    MsgBox _
        Prompt:="Finished", _
        Buttons:=vbInformation, _
        Title:="Success"
                
End Sub
 
Upvote 0
weavera said:
........I am trying to create a macro to copy rows from one worksheet called "data" if the value in cell "K" = "1" or "2". I then need the copied data to be pasted into a worksheet called "Priority Tests Only".

If the value in Cell "K" is higher than 2 (3, 4 or 5) then copy and paste into another worksheet called "other Tests".

Cell "K" in the "data" sheet has a long excel code to perform the calculations required in order to deliver 1, 2, 3, 4 or 5......
Click to expand...


Hi,

. I expect gpeacock has got you well sorted. His code looks extremely thorough!, and very well commented

. But think it may not be clear to anyone trying to follow exactly what you want or wanted.

. As always, “A (Good!) Picture paints a thousand words”

. . Can you Try to provide Tables that can be copied into a spreadsheet showing example data but also importantly exactly how the final output should look like in the Excel File based on your actual example data.


. There are various ways to do this. The first is preferred by this Forum for excel files as then everyone can see wot is going on quickly.. The Third method I prefer. - Then one can get on straight away with writing a code for you in the file you provide.

. 1 If you can, try uploading this, https://onedrive.live.com/?cid=8cffd...CE27E813%21189 instructions here MrExcel HTML Maker . This free Excel add-In is good for screen shots here of spreadsheets. Then everyone can quickly see what is going on and follow the Thread easily.
Or
. 2 Up left in the Thread editor is a table icon. Click that, create an appropriately sized table and fill it in. (To get this icon up in the Reply window you may need to click on the “Go Advanced” Button next to the Reply Button)
Or
. 3 Supply us with example Excel files (Can of course be shortened, or made - up data in case any info is sensitive)
. For example send over these 2 free things: FileSnack | Easy file sharing or Box Net,
Remember to select Share after uploading and give us the link they provide.

Alan Elston
… Sort of practicing VBA Sorting in Bavaria, Germany.
 
Upvote 0
gpeacock said:
.
.

Place the following macro into a standard code module in your workbook.

I've made these assumptions regarding your "Data" sheet:
(1) The top row contains headings; and
(2) The data starts in column A.

Code: 
Sub CopyData()
    
    'For "Data" worksheet:
    Dim DSht As Worksheet
    Dim DCnt As Long
    Dim DRng As Range
    Dim DTop As Range
    
    'For "Priorty" worksheet:
    Dim PSht As Worksheet
    Dim PRow As Long
    
    'For "Other" worksheet:
    Dim OSht As Worksheet
    Dim ORow As Long
    
    'For looping:
    Dim Cell As Range
    
    'Set variables for worksheets
    With ThisWorkbook
        Set DSht = .Worksheets("Data")
        Set PSht = .Worksheets("Priority Tests Only")
        Set OSht = .Worksheets("Other Tests")
    End With
    
    'Get headings & no. of records
    'from "Data" sheet and set
    'range for looping in col. K...
    
    With DSht
        Set DTop = Range(.Range("A1"), .Range("A1").End(xlToRight))
        DCnt = .Cells(.Rows.Count, "K").End(xlUp).Row
        Set DRng = .Range("K2:K" & DCnt)
    End With
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    'Set headings in "Priority"
    'sheet and determine
    'next empty row...
    
    With PSht
        .Range("A1").Resize(ColumnSize:=DTop.Count).Value = DTop.Value
        PRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With
    
    'Set headings in "Other"
    'sheet and determine
    'next empty row...
    
    With OSht
        .Range("A1").Resize(ColumnSize:=DTop.Count).Value = DTop.Value
        ORow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With
    
    'Loop through cells in col. K
    'on "Data" sheets and paste
    'rows to other sheets
    'depending on cell value...
    
    For Each Cell In DRng
        Select Case Cell.Value
            Case Is = 1, 2:
                Cell.EntireRow.Copy
                PSht.Cells(PRow, "A").PasteSpecial _
                    Paste:=xlPasteValuesAndNumberFormats
                PRow = PRow + 1
            Case Is = 3, 4, 5:
                Cell.EntireRow.Copy
                OSht.Range("A" & ORow).PasteSpecial _
                    Paste:=xlPasteValuesAndNumberFormats
                ORow = ORow + 1
        End Select
    Next Cell
    
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    
    MsgBox _
        Prompt:="Finished", _
        Buttons:=vbInformation, _
        Title:="Success"
                
End Sub
Click to expand...


GPeacock,

Thank you so much. It worked a treat! Sorry for the late reply. I think what people like you do is incredible and I am very grateful for your help.

Is it possible to only copy columns A, B, C, D, H & K from worksheet "Data" based on The same criteria for Column "K" (If Column K contains "1" & "2" paste into worksheet "Priority Tests Only". If Column K contains "3", "4", & "5" paste into worksheet "Other Tests" worksheet) instead of the whole row?

Sorry Mr P, I am being very necky now but I dare not meddle with the working code you just sent. Again...Thanks so much!
 
Upvote 0
gpeacock said:
...... the following macro ........

Code: 
Sub()..........
  
.................

              
End Sub
Click to expand...


Hi gpeacock,

. I am teaching myself how to do simple sorting codes with VBA, (by, amongst other things, answering Threads like this one. You got here first on this one: I am very glad you did!): - I found your code here particularly clearly written with (untypically) well written comments explaining exactly wot is going on. I was therefore able to follow it, understand it and therefore learn from it very quickly.
. Many thanks.
. Alan Elston.
 
Upvote 0
weavera said:
GPeacock,

Thank you so much. It worked a treat! Sorry for the late reply. I think what people like you do is incredible and I am very grateful for your help.

Is it possible to only copy columns A, B, C, D, H & K from worksheet "Data" based on The same criteria for Column "K" (If Column K contains "1" & "2" paste into worksheet "Priority Tests Only". If Column K contains "3", "4", & "5" paste into worksheet "Other Tests" worksheet) instead of the whole row?

Sorry Mr P, I am being very necky now but I dare not meddle with the working code you just sent. Again...Thanks so much!
Click to expand...


To keep things simple, you could simply add in some code towards the end of your macro to delete the unwanted columns, such as:

Code: 
    With PSht
        Columns("I:J").Delete
        Columns("E:G").Delete
    End With
    
    With OSht
        Columns("I:J").Delete
        Columns("E:G").Delete
    End With
 
Upvote 0
DocAElstein said:
Hi gpeacock,

. I am teaching myself how to do simple sorting codes with VBA, (by, amongst other things, answering Threads like this one. You got here first on this one: I am very glad you did!): - I found your code here particularly clearly written with (untypically) well written comments explaining exactly wot is going on. I was therefore able to follow it, understand it and therefore learn from it very quickly.
. Many thanks.
. Alan Elston.
Click to expand...


Thanks for the feedback. I am also learning by answering threads. I find it very useful when I find code that people have commented clearly, so I try to do the same when posting my own code...
 
Upvote 0
gpeacock said:
To keep things simple, you could simply add in some code towards the end of your macro to delete the unwanted columns, such as:

Code: 
    With PSht
        Columns("I:J").Delete
        Columns("E:G").Delete
    End With
    
    With OSht
        Columns("I:J").Delete
        Columns("E:G").Delete
    End With
Click to expand...

Hi GPeacock,

Thanks for that. I have just tried that but it deletes all columns except - A, B, C & D from worksheet "Data" and copies nothing into worksheets "Priority Tests Only" and "Other Tests". I ran this on a copy of the workbook. I am guessing that because it deleted column "K" then noting was copied across as that was the column containing the variables "1"-"5".

I copied the code into the original code after the final "End If"
If you can help again then I would very much appreciate it...Where do I send the beers?
 
Upvote 0
.
.

Sorry, there was a small mistake in the new section! It should be:

Code: 
    With PSht
        .Columns("I:J").Delete
        .Columns("E:G").Delete
    End With
    
    With OSht
        .Columns("I:J").Delete
        .Columns("E:G").Delete
    End With

(Notice that I originally neglected to include the dot (.) operators.)

.
.

Place the new section in just before the last block of code, i.e. just before the block:

Code: 
With Application
        .CutCopyMode = False
        .ScreenUpdating = True
        .DisplayAlerts = True
End With

It should delete the unwanted columns from your Priority Tests and Other Tests worksheets, while leaving the Data worksheet untouched...
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
Button produces different result
Replies
3
Views
104
RoryA
RoryA
J
  • Question
Change specific values (not all) in a VBA sub
2
Replies
16
Views
443
juscuz419
J
G
  • Question
Calling macro via IF statement when range values are present
Replies
2
Views
196
NoSparks
N
R
  • Question
Macro not working after adding two new items
Replies
4
Views
94
myall_blues
myall_blues
R
  • Question
Help with Macros
Replies
1
Views
277
t0ny84
T

Forum statistics

Threads
1,214,649
Messages
6,120,731
Members
448,987
Latest member
marion_davis

Share this page

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