Copying specific condition meeting data from one worksheet to another

ttvlee

New Member
Joined
Feb 7, 2014
Messages
5
Hi all


I really need some help. I am very new to VBA but i think this should be able to be done but don't know how.


I want to be able to do the following:


Seach column R - if the date range is in Jan 2014 (currently displayed as 05 Jan, 14 Jan, 30 Jan)
then pull the information of:


column A, B, C, D, E, G, AK, AB, AL, R, AF, AG, AH, AI, AJ, AM from sheet 1 and paste it to worksheet 2 (or we could call it January 2014 - whichever is easiest)


Seach column R - if the date range is in Feb 2014 then pull


column A, B, C, D, E, G, AK, AB, AL, R, AF, AG, AH, AI, AJ, AM from sheet 1 and paste to worksheet 3 (Feb 2014)


March 2014 to worksheet 4 (March 2014)
April 2014 to worksheet 5 (April 2014)
and so forth


Is this possible? Can this information automatically update? So if i amend sheet 1 the amend is updated in the relevant sheet?


Can anyone help?
 

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.
try this code, I am not sure how to paste the columns you asked other way than in the code. it is possible to make code shorter but it requires to have another sheet with row numbers which need to be copied.
This is better way as you can actually then add remove or change the order of the columns much easier. So let me know if you will want to change it.

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code:
Sub test()


Dim ws As Worksheet, cws As Worksheet
Dim iMonth As Integer, iYear As Integer, irow As Long, xrow As Long


Set cws = ActiveSheet


irow = 1
Do Until Cells(irow, 18) = Empty
    If IsDate(Cells(irow, 18)) = True Then
        xrow = Empty
        iMonth = Month(Cells(irow, 18))
        iYear = Year(Cells(irow, 18))
            Set ws = Nothing
            On Error Resume Next
            Set ws = Sheets(iMonth & " " & iYear)
            On Error GoTo 0
            If ws Is Nothing Then Sheets.Add.Name = iMonth & " " & iYear
            Set ws = Sheets(iMonth & " " & iYear)
        ws.Activate
        xrow = Cells(10000, 1).End(xlUp).Row + 1
        
        cws.Activate
        Range(Cells(irow, 1), Cells(irow, 5)).Copy
        ws.Activate
        Cells(xrow, 1).Select
        ActiveSheet.Paste
        
        cws.Activate
        Cells(irow, 7).Copy
        ws.Activate
        Cells(xrow, 6).Select
        ActiveSheet.Paste
        
        cws.Activate
        Cells(irow, 37).Copy
        ws.Activate
        Cells(xrow, 7).Select
        ActiveSheet.Paste
        
        cws.Activate
        Cells(irow, 28).Copy
        ws.Activate
        Cells(xrow, 8).Select
        ActiveSheet.Paste
        
        cws.Activate
        Cells(irow, 38).Copy
        ws.Activate
        Cells(xrow, 9).Select
        ActiveSheet.Paste
        
        cws.Activate
        Cells(irow, 18).Copy
        ws.Activate
        Cells(xrow, 10).Select
        ActiveSheet.Paste
        
        cws.Activate
        Range(Cells(irow, 32), Cells(irow, 36)).Copy
        ws.Activate
        Cells(xrow, 11).Select
        ActiveSheet.Paste
        
    End If
irow = irow + 1
Loop
End Sub
 
Upvote 0
Hi skorpionkz

Thanks for coming back to me this seemed to work - it pulled across all the columns i wanted.

I tested it with a worksheet of 19 lines and it pulled across 1 line of data.

Where do i need to change the code in order to pull across several lines that meet the criteria?

Also will i need to repeat this code for each different month?

One more thing - i assume in order to get the most up to date data i need to run the macro (i.e if i amend the main sheet and want the info to be correct in the pasted sheets) - what is the code that allows me to run the macro and stops it adding a duplicate each time i run the macro to the pasted worksheet?
 
Upvote 0
Where do i need to change the code in order to pull across several lines that meet the criteria?

The code should go until end of your sheet.
Basically code start to check from column R from row 1 and checking line by line.
If code will find the Date value it will pull all requested rows.
If code will found empty cell, then it will stop. If for some reason you have some empty cells in column R, can you give the sample file so I can adjust the code. To upload sample file you can use any of storage services (exp. DropBox) and paste link here.

Also will i need to repeat this code for each different month?

No you dont need to repeat code for each month. As I mention above the code will check each row.
When it find any date in the row it currently check. code will pull Month and Year from it, then check if sheet for this month and year already exists (if not then create) and pull all requested rows to this sheet.

One more thing - i assume in order to get the most up to date data i need to run the macro (i.e if i amend the main sheet and want the info to be correct in the pasted sheets) - what is the code that allows me to run the macro and stops it adding a duplicate each time i run the macro to the pasted worksheet?

this is more complex.
I can try to adjust the code, but I need to see sample file. Is there in any column which we are moving to new sheet that have the unique value? if so then I can adjust the code to avoid duplicates, if not then again I need to see sample file.

Alternatively, before adding new entries to main database you can add it to new worksheet and run the code and then move new data to main database, but this is not a good solution if you update database every day.
 
Upvote 0
The code should go until end of your sheet.
Basically code start to check from column R from row 1 and checking line by line.
If code will find the Date value it will pull all requested rows.
If code will found empty cell, then it will stop. If for some reason you have some empty cells in column R, can you give the sample file so I can adjust the code. To upload sample file you can use any of storage services (exp. DropBox) and paste link here.

The code doesn't work like that - there are no empty cells in column R - but it only pulls through 1 row of data.

Please find the test document here: https://www.dropbox.com/s/8cknfe6mucxzm4q/Testsheetv1.xlsm


No you dont need to repeat code for each month. As I mention above the code will check each row.
When it find any date in the row it currently check. code will pull Month and Year from it, then check if sheet for this month and year already exists (if not then create) and pull all requested rows to this sheet.

I am not sure the code is working as suggested above - it has not pulled through onto other worksheets for other months.

I can try to adjust the code, but I need to see sample file. Is there in any column which we are moving to new sheet that have the unique value? if so then I can adjust the code to avoid duplicates, if not then again I need to see sample file.


There is currently no unique data on the spreadsheet to define to avoid duplicates - however is there a way for the code to check within the pasted data to remove duplicates? Or would it be better to add a column with a unique number?
 
Upvote 0

There is currently no unique data on the spreadsheet to define to avoid duplicates - however is there a way for the code to check within the pasted data to remove duplicates? Or would it be better to add a column with a unique number?
There is the way to check duplicates, if for example column Customer and Title will give the unique value.

I missed 1 line in the code, and this is a reason why it didnt work how it should.

Code:
Sub test()

Dim ws As Worksheet, cws As Worksheet
Dim iMonth As Integer, iYear As Integer, irow As Long, xrow As Long

Set cws = ActiveSheet

irow = 1
Do Until Cells(irow, 18) = Empty
    If IsDate(Cells(irow, 18)) = True Then
        xrow = Empty
        iMonth = Month(Cells(irow, 18))
        iYear = Year(Cells(irow, 18))
            Set ws = Nothing
            On Error Resume Next
            Set ws = Sheets(iMonth & " " & iYear)
            On Error GoTo 0
            If ws Is Nothing Then Sheets.Add.Name = iMonth & " " & iYear
            Set ws = Sheets(iMonth & " " & iYear)
        ws.Activate
        xrow = Cells(10000, 1).End(xlUp).Row + 1
        
        cws.Activate
        Range(Cells(irow, 1), Cells(irow, 5)).Copy
        ws.Activate
        Cells(xrow, 1).Select
        ActiveSheet.Paste
        
        cws.Activate
        Cells(irow, 7).Copy
        ws.Activate
        Cells(xrow, 6).Select
        ActiveSheet.Paste
        
        cws.Activate
        Cells(irow, 37).Copy
        ws.Activate
        Cells(xrow, 7).Select
        ActiveSheet.Paste
        
        cws.Activate
        Cells(irow, 28).Copy
        ws.Activate
        Cells(xrow, 8).Select
        ActiveSheet.Paste
        
        cws.Activate
        Cells(irow, 38).Copy
        ws.Activate
        Cells(xrow, 9).Select
        ActiveSheet.Paste
        
        cws.Activate
        Cells(irow, 18).Copy
        ws.Activate
        Cells(xrow, 10).Select
        ActiveSheet.Paste
        
        cws.Activate
        Range(Cells(irow, 32), Cells(irow, 36)).Copy
        ws.Activate
        Cells(xrow, 11).Select
        ActiveSheet.Paste
        
    End If
irow = irow + 1
cws.Activate
Loop

cws.Activate
For Each ws In Sheets
    If Not ws.Name = cws.Name Then
        cws.Activate
        Range(Cells(1, 1), Cells(1, 5)).Copy
        ws.Activate
        Cells(1, 1).Select
        ActiveSheet.Paste
        
        cws.Activate
        Cells(1, 7).Copy
        ws.Activate
        Cells(1, 6).Select
        ActiveSheet.Paste
        
        cws.Activate
        Cells(1, 37).Copy
        ws.Activate
        Cells(1, 7).Select
        ActiveSheet.Paste
        
        cws.Activate
        Cells(1, 28).Copy
        ws.Activate
        Cells(1, 8).Select
        ActiveSheet.Paste
        
        cws.Activate
        Cells(1, 38).Copy
        ws.Activate
        Cells(1, 9).Select
        ActiveSheet.Paste
        
        cws.Activate
        Cells(1, 18).Copy
        ws.Activate
        Cells(1, 10).Select
        ActiveSheet.Paste
        
        cws.Activate
        Range(Cells(1, 32), Cells(1, 36)).Copy
        ws.Activate
        Cells(1, 11).Select
        ActiveSheet.Paste
    End If
Next ws

cws.Activate
    
End Sub

I also added code to copy header
 
Last edited:
Upvote 0
I am looking at the Sample file you send, quick question.
do you always have data sorted by column R (so by date).
 
Upvote 0
Check both codes from attached file.

"Module 1" is a bit faster version of the previous code. Basically this code, instead of copying line by line, checking the dates and copy all rows in the row which has same month and year in Date column ("R")

"Module 2". This is much more flexible version of the code. As you can see there is an additional sheet added which contains the number of columns you want to copy and their order. This way you can modify the output at anytime. Additionally this code is shorter and i think easier to read.

https://www.dropbox.com/s/b5hnncgmo3s5zwa/Testsheetv1.xlsm

I didn't add the unique check as I am still waiting for your answer about this. Does merged value from any 2 or 3 columns, that need to be copied, gives the unique value?
 
Upvote 0
I didn't add the unique check as I am still waiting for your answer about this. Does merged value from any 2 or 3 columns, that need to be copied, gives the unique value?

I think merge values of column B (title), column D (Printer Order) and column E (customer) would give a unique value. This coil
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,237
Members
448,555
Latest member
RobertJones1986

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