How do I cut & paste rows to a new workbook based on a changing value? 1

[Kelser]

I receive a sheet each week with the data in the following format. What I have to do is select rows based on the number in col D then move those rows to a new workbook. So all the rows with 10 in the D col go into a new book, then all the rows with 12 in the D col go into another new book etc. However, next time I receive the data, the numbers in col D might be a different set of numbers. By the way, I use Excel 2003. Any help would be very gratefully received as I know very little re VBA.

A B C D E F
txt txt txt 10 txt num
txt txt txt 10 txt num
txt txt txt 12 txt num
txt txt txt 12 txt num
txt txt txt 20 txt num
txt txt txt 20 txt num
txt txt txt 20 txt num

 

[SkipVought]

Hi,

I'd use MS Query to IMPORT the data into your workbook.

faq68-5829.

Once you have the process manually working, turn on your macro recorder to generate code.

Post back with your recorded code when you're ready for help customizing.

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[Kelser]

Hi

Thanks for your reply. I've spent the time since posting searching the net trying to get a handle on VBA code. As you suggested, I recorded a macro and this is the result:
Sub Test()
'
' Test Macro
''
Rows("2:6").Select
Selection.Cut
Workbooks.Add
ActiveSheet.Paste
Windows("example.xls").Activate
Rows("7:16").Select
Selection.Cut
Workbooks.Add
ActiveSheet.Paste
Range("H9").Select
End Sub

I've seen a lot of code for counting rows and this uses a variable. I presume I will need to do something similar? Obviously I don't want specific rows to be mentioned, as that is changing. What I haven't been able to discover is how to get it to look for changing values. Am I on the right track?

 

[SkipVought]

The rows could be selected using the AutoFilter.

Copy ALL the rows in the data area.

Edit, Paste special - VALUES at the destination cell.

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[Kelser]

Hi again

Thanks for your continued help. I've done as you suggested and this is the code I've generated:

Sub Test()
'
' Test Macro

Selection.AutoFilter Field:=4, Criteria1:="106"
Rows("1:6").Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Book2").Activate
Selection.AutoFilter Field:=4, Criteria1:="107"
Rows("1:16").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Book2").Activate
Selection.AutoFilter Field:=4, Criteria1:="108"
Rows("1:26").Select
Application.CutCopyMode = False
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub


The above code works perfectly for the 3 filters that I selected on Column D using numbers 106, 107 and 108 (as shown above). So the next step, I think, is to get it to look for the different criteria by itself? There is actually some 10 different criteria in this workbork, but the next book I get through might have 15 criteria etc. It's always changing.
But the above code is giving me the result that I want, for the criteria that it picks, so it's definitely on the right road!

 

[SkipVought]

look for the different criteria by itself

based on what logic?

You might construct a table of these criteria and drive the process from the data in the table.

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[Kelser]

Hi

Unfortunately, I can't construct a table of the criteria, as the values in the D column change every time I get sent a new book. The only thing that remains the same, is that column D is always numbers, never text.

 

[SkipVought]

Then based on WHAT will you look for different criteria?

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[Kelser]

Hi

Thats where I get stumped. I was hoping that I might be able to ask it to look at the first value in column d, create a filter to show only the repeat of that value, then when I take out that value (will have to use a Cut) that it can then look for the next value in column d and repeat the process. Am I asking for the impossible?

 

[SkipVought]

Suppose you post a small example of what you might have and then explain and post and example of what result(s) you want.

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[Kelser]

Hi
I'm very excited cos I nearly have it! This is the code i put in based on what I've been picking up in some tutorials on the net and what you have told me to do:

Sub Testing()
'
' Testing Macro
'
Dim x As Integer

Do
x = Range("D1").Select
ActiveCell.Offset(x + 1, 0).Select
If Not Selection.Value > "" Then Exit Do
Selection.AutoFilter Field:=4, Criteria1:=x
ActiveCell.CurrentRegion.Select
Selection.Cut
Workbooks.Add
ActiveSheet.Paste
Columns("A:K").Select
Columns("A:K").EntireColumn.AutoFit
Windows("Book2").Activate
Loop
End Sub

It worked perfectly EXCEPT each selection was not pasted into a new workbook, but all into the same workbook!

So if you look at the information that I first posted, when you do an autofilter based on column d, it will bring up 2 rows (based on the value 10 in col d). I then want to cut those 2 rows of information (i couldn't work it properly with a copy) and paste them into a new workbook. Then I want to do a filter to select the next number in col D, which in the case of the above, is 12, select all the rows containing 12 in col D, cut them and place them into another new workbook. The info I placed above looks as if it is sorted by col D but that wouldn't be the case in real life.

 

[SkipVought]

Do you want a NEW workbook for each row you are filtering?

If your filter criteria values in column D are UNIQUE, then why filter? Just copy that row to another workbook. Otherwise, you FIRST need to generate a UNIQUE LIST of flter criteria values, using the Advanced Filter - UNIQUE values.

Don't think that this is what you want to do.

Sub Testing()
'
' Testing Macro
'
    Dim x As Integer, r As Range, ws As Worksheet
    
    Set ws = ActiveSheet
    
    For Each r In ws.Range(ws.[D1], ws.[D1].End(xlDown))
        ws.[D1].AutoFilter _
            Field:=4, _
            Criteria1:=r.Value
            
        r.CurrentRegion.Copy
        
        With Workbooks.Add
            With .Sheets(1)
                .Paste
                .UsedRange.EntireColumn.AutoFit
                .SaveAs "YourFilename??????????.xls"
                .Close
            End With
        End With
    Next
End Sub

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[Kelser]

Sorry, I obviously haven't explained myself very well. The result of the filter on column D could be any amount of rows, so I could get 2 rows from the result, but equally there could be 20 rows in the result. Each filtered result is to be moved to a completely new workbook. So if I filter for the value 20 in col D and I get back 15 results, those 15 rows are to be cut (I think cut might be better) and placed into a new workbook. Then I want to filter for the next value in column D (say the value 25) and if I get back 7 rows of results then I want to cut those 7 rows and place them into yet another new book, not the same book as the previous value. So each set of filtered rows are placed into different books. So if there are 15 unique values in col D, I will have 15 new workbooks that the cut information has gone into.

I tried to run your code but got an error at the line

.close

that said:
Runtime Error '435'
Object doesn't support this property of method

and the headings had copied across, but not any other data?

By the way, I really do appreciate the help you are giving me.

 

[SkipVought]

ok

Sub Testing()
'
' Testing Macro
'
    Dim r As Range, ws As Worksheet, i As Integer
    
    Set ws = ActiveSheet
    
    i = 1
    For Each r In ws.Range(ws.[D2], ws.[D2].End(xlDown))
        ws.[D1].AutoFilter _
            Field:=4, _
            Criteria1:=r.Value
            
        r.CurrentRegion.Copy
        
        With Workbooks.Add
            With .Sheets(1)
                .Paste
                .UsedRange.EntireColumn.AutoFit
                .SaveAs "c:\test" & i & ".xls"
            End With
            .Close
        End With
        i = i + 1
    Next
End Sub

See if that will work for you.

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[Kelser]

I tried the new code and got caught in a loop, I managed to stop it at 87 workbooks! I had a look in some of the books and it was the same set of rows that was copied each time. I can see now that I need to copy row 1 (the headings) to each book, but might have to cut the result of the filter, so that it doesn't keep looking for the same value?

 

[SkipVought]

Thats why I suggested a list of unique values to loop thru. Sorry, I lost track of that part of the requirement.

Sub Testing()
'
' Testing Macro
'
    Dim r As Range, ws As Worksheet, i As Integer
    
    Set ws = ActiveSheet
    
    i = 1
    For Each r In [b][YourUniqueList][/b]
        ws.[D1].AutoFilter _
            Field:=4, _
            Criteria1:=r.Value
            
        r.CurrentRegion.Copy
        
        With Workbooks.Add
            With .Sheets(1)
                .Paste
                .UsedRange.EntireColumn.AutoFit
                .SaveAs "c:\test" & i & ".xls"
            End With
            .Close
        End With
        i = i + 1
    Next
End Sub

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[Kelser]

I'm getting an End Time Error '424'
Object Required
at this line:
For Each r In [106, 107, 108, 110, 111, 114, 116, 119, 127, 139, 140, 161, 175, 187, 192, 194]

They are the unique values in my list. Have I written them incorrectly?

 

[SkipVought]

You are making it difficult.

Put this list in a RANGE somewhere. Name the DATA, using the Name Box,

Use that Range Name in...

For Each r In [YourRangeName]

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[Kelser]

Sorry for being so slow! I'm also sorry for being such a nuisance. I created the range, but when I ran the code it actually copied and pasted the range I had created as opposed to the rows of data.

 

[SkipVought]

Please paste your code.

Explain where your filtered table is (sheet & range) and where your list of unique values is.

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}