PDA

View Full Version : Copying & pasting with a For...Next Loop



BexleyManor
06-21-2006, 01:32 PM
Hi folks,

My head is rattled with the piece of code below:-

path = "C:\test File.xls"
Set Wkb = Workbooks.Open(path)
ThisWorkbook.Activate

dnum = Array("3", "4", "6", "7", "8", "11", "15", "16", "17", "18", _
"29", "38", "41", "62")

dep = Array("Site 3", "site 4", "Site 6", "Site 7", "Site 8", _
"Site 11", "Site 15", "Site 16", "Site 17", "Site 18", _
"Site 29", "Site 38", "Site 41", "Site 62")

ActiveSheet.Cells(1, 1).Select

For iii = LBound(dnum) To UBound(dnum)
For iiii = LBound(dep) To UBound(dep)
Selection.AutoFilter Field:=1, Criteria1:=dnum(iii)
Selection.CurrentRegion.Copy Destination:=Wkb.Sheets(dep(iiii)).Cells(1, 1)
Next iiii
Next iii

To explain a little further, In the main workbook I need to perform filters on each depot number and then copy that into the workbook Test.xls on the corresponding worksheet. Everything seems to work fine except where it comes to copying the data to the Test.xls worksheets. I just seem to get the filter for dnum 52 copied to each sheet??

Any suggestions, I'm going nuts and developing a classic 1000yd stare with this!! :doh:

Thanks

Ken Puls
06-21-2006, 03:03 PM
Hi Bexley,

At first glance, it looks like you're destination is the same on each iteration of the loop:

Destination:=Wkb.Sheets(dep(iiii)).Cells(1, 1)

Try:
Destination:=Wkb.Sheets(dep(iiii)).Cells(Wkb.Sheets(dep(iiii)).Rows.Count, 1).End(xlup).offset(1,0)

(I wrote it in the browser, so you may need to tweak it.)

HTH,

BexleyManor
06-21-2006, 03:14 PM
Hi Ken,

I just tried your code however it does the same as mine did with the exception dnum 3 gets copied to every sheet instead of dnum 52, effectively the lbound of the dnum array whereas I had the ubound copied to each sheet!!

Ken Puls
06-21-2006, 03:22 PM
Any way you can upload a santized workbook? It would be easier to step through the code, I think, with some source data. Only need a source workbook, too, not the destinations, as we can just create the sheets easily to match it.

BexleyManor
06-21-2006, 03:45 PM
Certainly. I would walk across hot coals if it helps!! I've hacked the list down as it's some 26,000+ Lines.

I think it'ssomething to do with pasting special values but It's nearly 1am and I can't think straight now!


I'm also wondering if it would be easier to create a new workbook to export the data to??

Ken Puls
06-21-2006, 04:24 PM
I'll try and take a look a little later tonight. If you can upload a file, that would be great. :)

BexleyManor
06-21-2006, 04:49 PM
I'm so tired, I forgot to upload the workbook, arrrghhh!!

XLGibbs
06-21-2006, 08:23 PM
Okay, I took a look, but only one of the files was in the zip...so i can't test out what you are trying to do.

However, your code does not specify to only copy the filter information, as you are using


Option Explicit
Sub CustSplit()
Dim WkbSource As Workbook, WkbDest As Workbook
Dim WksSource As Worksheet, WksDest As Worksheet
Dim strdate As String, path As String, destpath
Dim lngLABS As Long, lngCounter As Long, lngDEP As Long, lngDNUM As Long
Dim dnum(), dep(), labs()


lngCounter = 1 ' set your counter

Application.ScreenUpdating = False
Application.StatusBar = "Please wait, code at work...!!"
path = "C:\mainlist.xls"

Set WkbSource = ThisWorkbook
'''''''''''''''''''''''' create the header
With ActiveSheet
.Rows("1:1").Insert Shift:=xlDown

.Range(Cells(1, 1), Cells(1, 11)) = Array("Depot No.", "Customer No.", "Customer Name", "Post Code", "Telephone No.", _
"Mon", "Tues", "Wed", "Thurs", "Fri", "Operator")

End With

' set the source page
Set WksSource = WkbSource.Sheets("MainList")

'set the array for the filter as you had done
dnum = Array("1", "3", "4", "6", "7", "8", "11", "13", "15", "16", "17", "18", "19", "28", "31", "50", "52", "53", "90")

MkDir "C:\Test" 'make a path for the new files

destpath = "C:\Test\" 'string the pathway

''''''''loop through, filter and create workbook for each Depot
For lngDNUM = LBound(dnum) To UBound(dnum)

Workbooks.Add ' add a workbook
Set WkbDest = ActiveWorkbook
Set WksDest = WkbDest.Sheets(1)

WksDest.Name = "Depot " & dnum(lngDNUM)

With WksSource
.Activate
.Cells(1, 1).AutoFilter Field:=1, Criteria1:=dnum(lngDNUM)
Cells.Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy WksDest.Cells(1, 1)

.ShowAllData
End With

WkbDest.SaveAs destpath & "Depot " & dnum(lngDNUM) 'name the file
WkbDest.Close False
Set WkbDest = Nothing

Next lngDNUM



Application.StatusBar = "Copying now complete."

Application.ScreenUpdating = True
End Sub


I have simplified it quite a bit, but I only spent about 10 minutes on it...it works.

What it will do is cycle through your depot numbers, filter the list, add a workbook, name the sheet the depot #, then copy the filtered data to it, save the new file, close the new file. Rinse/Repeat.

Note that I add the directory in the code, so you would want to specify your desitnation or desired new folder name (it could be in a cell if you wish...)

Hope that helps. It worked with the file you uploaded..

Ken Puls
06-21-2006, 08:36 PM
...your code does not specify to only copy the filter information, as you are using

:doh: How did I miss that?

Thanks, Pete! ;)

BexleyManor
06-22-2006, 06:14 AM
Hey Guys,

Wow, thanks for your suggestions. I ran Pete's code, which indeed does work, however it's a slight twist on what I was actually looking for. Rather than creating a new workbook for each copy action I would simply like the data to be pasted to the 2nd workbook into the 19 corresponding sheets.

I shall have a go at re-hashing Pete's fine code to see If I can't get this working myself, failing that I'll be back with tail between legs asking more questions!!

Catch you in the next episode...

BexleyManor
06-22-2006, 09:45 AM
I'm back. No suprise there!!

Had a tinker with Pete's code but it was too much for me so I'm back again to see if anyone can tell me how to do the 'PasteSpecial' magic with my original code??


For iiii = LBound(dep) To UBound(dep)
For iii = LBound(dnum) To UBound(dnum)
ActiveSheet.Cells(1, 1).Select
Selection.AutoFilter Field:=1, Criteria1:=dnum(iii)
Selection.CurrentRegion.Copy Destination:=Wkb.Sheets(dep(iiii)).Cells(1, 1)
Next iii
Next iiii

Thanks, again...and again and again!!

XLGibbs
06-22-2006, 10:23 AM
That is not a very hard modification to make..

Instead of WkbDest being the Workbook.Add open the file

Workbooks.Open etc etc.

Then set wkbDest = "that workbook"

Instead of renaming the workbook and sheet, you would just change the destination to

WkbDest.Sheets("Depot " & lngDNUM).Cells(1,1)

which would allow you to paste into the proper sheet.

Let us know if you get stuck..

BexleyManor
06-22-2006, 10:29 AM
Pete, you are God like in you're ability to make the storm clouds in my mind pass!!

I shall have another tinker with your suggestion and report back the results later...

Thanks mate!!

XLGibbs
06-22-2006, 02:54 PM
I would have posted the solution for you, but then you wouldn't learn nothin!

Let me know how it goes.

BexleyManor
06-22-2006, 03:59 PM
It goes badly but I'm hacking away at it, determined not to be beaten!!

On my original code I have two arrays. The second with "site 1", "site 2" is a 'sanitized' version of my code yet it essential as I was using this to tie in with the actual sheet names on the second workbook. As I try to weave this back into your code I start to get lost.

Also, when I do the Set Wkbdes = "C:\Test File.xls" I get an error??

I must sleep now, brain hurts!!

Ken Puls
06-22-2006, 04:18 PM
I think you've got a bit of a mixture of code there...

If the workbook is closed:
Sub test()
Dim wbtest As Workbook
Set wbtest = Workbooks.Open("C:\temp\Book2.xls")

End Sub

If it's open:
Sub test2()
Dim wbtest As Workbook
Set wbtest = Workbooks("Book2.xls")

End Sub

Ken Puls
06-22-2006, 04:20 PM
FYI, I'm not going to have any time to look at this tonight at all, but maybe post the code to date. I'm guessing that it's gone through a couple of revisions by now... :)

BexleyManor
06-23-2006, 02:33 PM
Hi Ken, quite true the code keeps evolving though sadly my keeping up with it isn't. It took me an age to write my own sloppy code and kinda understand it so pete's magic has me scratching my head, heavily!!

Any further input or direction glady received but until then I'll keep plugging away!!

XLGibbs
06-23-2006, 05:26 PM
Here is a quick mod which will open the destination file and filter/copy depot data to the appropriate tabs. Assumes the tab names are "Depot 1" "Depot 3" etc..



Option Explicit
Sub CustSplit()
Dim WkbSource As Workbook, WkbDest As Workbook
Dim WksSource As Worksheet, WksDest As Worksheet
Dim strdate As String, path As String, destpath
Dim lngLABS As Long, lngCounter As Long, lngDEP As Long, lngDNUM As Long
Dim dnum(), dep(), labs()


Application.ScreenUpdating = False
Application.StatusBar = "Please wait, code at work...!!"
path = "C:\mainlist.xls"

Set WkbSource = ThisWorkbook
'''''''''''''''''''''''' create the header
With ActiveSheet
.Rows("1:1").Insert Shift:=xlDown

.Range(Cells(1, 1), Cells(1, 11)) = Array("Depot No.", "Customer No.", "Customer Name", _
"Post Code", "Telephone No.", _
"Mon", "Tues", "Wed", "Thurs", "Fri", "Operator")

End With

' set the source page
Set WksSource = WkbSource.Sheets("MainList")

Workbooks.Open "C:\Test\DestFile.xls"
Set WksDest = Workbooks("DestFile.xls")
'change the above file name and path to the desired

'set the array for the filter as you had done
dnum = Array("1", "3", "4", "6", "7", "8", "11", "13", "15", "16", "17", "18", "19", "28", _
"31", "50", "52", "53", "90")

''''''''loop through, filter and create workbook for each Depot
For lngDNUM = LBound(dnum) To UBound(dnum)

Workbooks.Add ' add a workbook

WkbDest.Name = "Depot " & dnum(lngDNUM)

With WksSource
.Activate
.Cells(1, 1).AutoFilter Field:=1, Criteria1:=dnum(lngDNUM)
Cells.Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy WkbDest.Sheets("Depot " & dnum).Cells(1, 1)

.ShowAllData
End With

Next lngDNUM

WkbDest.Save 'saves the file
WkbDest.Close False 'closes the dest file
Set WkbDest = Nothing 'clear memory of object


MsgBox "Copying now complete."

Application.ScreenUpdating = True
End Sub

BexleyManor
06-23-2006, 05:58 PM
Hi Pete,

I'm still at it with this one!!

I changed the file names and also included my array of actual depot names as the tabs do have specific names, not just Depot 1 etc.

I now get the code grinding to a halt at...

At the line Set WksDest = Workbooks("myfile.xls") I get a type mismatch error??

Gotta go sleep now, 2.10am. zzzzzzz !!

XLGibbs
06-23-2006, 06:01 PM
Sorry should be:

Set WkbDest = Workbooks("Customer Split File.xls")



I had Wks instead of Wkb so it was expecting a worksheet (as WksDest was Dim'd as Worksheet object)...make that change and shout back.

BexleyManor
06-25-2006, 01:11 PM
Hi Pete,

I made the change, I really should have picked that up myself!! However, the code runs and copies but it copies the same series of data to ever worksheet and not as specified in the autofilter??

I have sat and looked at this for an age yet can't understand why??

mdmackillop
06-25-2006, 02:10 PM
Try this slightly revised version. I'm finding that my PC runs out of resources before the full array is stepped through.

Option Explicit
Sub CustSplit()
Dim WkbSource As Workbook, WkbDest As Workbook
Dim WksSource As Worksheet, WksDest As Worksheet
Dim strdate As String, path As String, destpath
Dim lngLABS As Long, lngCounter As Long, lngDEP As Long, lngDNUM As Long
Dim dnum(), dep(), labs()
Application.ScreenUpdating = False
Application.StatusBar = "Please wait, code at work...!!"
path = "C:\mainlist.xls"
Set WkbSource = ThisWorkbook
'''''''''''''''''''''''' create the header
With ActiveSheet
.Rows("1:1").Insert Shift:=xlDown
.Range(Cells(1, 1), Cells(1, 11)) = Array("Depot No.", "Customer No.", "Customer Name", _
"Post Code", "Telephone No.", _
"Mon", "Tues", "Wed", "Thurs", "Fri", "Operator")
End With
' set the source page
Set WksSource = WkbSource.Sheets("MainList")
Workbooks.Open "C:\Test\DestFile.xls"
Set WkbDest = Workbooks("DestFile.xls")
'change the above file name and path to the desired
'set the array for the filter as you had done
dnum = Array("1", "3", "4", "6", "7", "8", "11", "13", "15", "16", "17", "18", "19", "28", _
"31", "50", "52", "53", "90")
''''''''loop through, filter and create workbook for each Depot
For lngDNUM = LBound(dnum) To UBound(dnum)
With WkbDest
.Worksheets.Add ' add a workbook
.ActiveSheet.Name = "Depot " & dnum(lngDNUM)
Set WksDest = .ActiveSheet
End With
With WksSource
.Activate
.Cells(1, 1).AutoFilter Field:=1, Criteria1:=dnum(lngDNUM)
.Cells.SpecialCells(xlCellTypeVisible).Copy _
WksDest.Cells(1, 1)
.ShowAllData
End With
Next lngDNUM
WkbDest.Save 'saves the file
WkbDest.Close False 'closes the dest file
Set WkbDest = Nothing 'clear memory of object

MsgBox "Copying now complete."
Application.ScreenUpdating = True
End Sub

XLGibbs
06-25-2006, 05:00 PM
MD's code is revised from the original which creates a new workbook...

the error you describe is this:

Selection.Copy WkbDest.Sheets("Depot " & dnum).Cells(1, 1)
which should be

Selection.Copy WkbDest.Sheets("Depot " & dnum(lngDNUM)).Cells(1, 1)


Sorry for the error there..

mdmackillop
06-25-2006, 10:53 PM
Hi Pete,
I ran into an error here, hence my change.
Regards
MD


For lngDNUM = LBound(dnum) To UBound(dnum)
Workbooks.Add ' add a workbook
WkbDest.Name = "Depot " & dnum(lngDNUM)


Edit: Tried it again, and no error, but obviosly a different result!

BexleyManor
06-26-2006, 03:19 PM
ha ha ha, thanks MD. Now I have my brains dribbling out of my ears I've so much code to look at!!!!!


Right, here's the problem as it stands.


For lngDNUM = LBound(dnum) To UBound(dnum)
For ii = LBound(dep) To UBound(dep)

With WksSource
.Activate
.Cells(1, 1).AutoFilter Field:=1, Criteria1:=dnum(lngDNUM)
Cells.Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy WkbDest.Sheets(dep(ii)).Cells(1, 1)
.ShowAllData
End With
Next ii
Next lngDNUM

I have another array that has the actual depot names that relate to the workbook sheets I'm copying to. It's always been in my code, I took it out to sanitize the code for the web. You can see above how I've worked it into Pete's code. Now, when I run the code the Autofilter doesn't seem to work and I get the same series of data copied to every worksheet and I cannot figure out why??

I'm at the same point as I was when I originally posted my tatty version code only I have a complete new set of code but with the same problem!!!

I'm glad you guys like a challenge because I'm certainly that!! ha ha ha

mdmackillop
06-27-2006, 11:19 PM
Hi Bexley,
Can you sanitise and post your workbook?
Regards
MD

BexleyManor
06-28-2006, 03:33 PM
As requested MD. I've cut the list down as it's some 26,000 lines+ normally.

I'm now starting to wonder if it would be better for the main list file to create a new workbook then copy across the data into new sheets. would this make things easier codewise??

I don't think my user would know what to do if the 2nd workbook was moved from it's location so I think this approach may be more prudent, don't you think??

BexleyManor
07-04-2006, 03:11 PM
Anyone with any fresh ideas for this little beauty??

It's still driving me up the wall!!!

XLGibbs
07-04-2006, 04:17 PM
Comments applicable perhaps


For lngDNUM = LBound(dnum) To UBound(dnum) ' cycle through depot numbers/filters
For ii = LBound(dep) To UBound(dep) 'cycle through sheet locations ?

With WksSource
.Activate
.Cells(1, 1).AutoFilter Field:=1, Criteria1:=dnum(lngDNUM) 'filter based on top/outer loop
Cells.Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy WkbDest.Sheets(dep(ii)).Cells(1, 1) 'copy to each sheets
.ShowAllData
End With
Next ii 'next sheet
Next lngDNUM 'next filter
[/vba]

Looks to me in this code like you are filtering once, then copying to each and every sheet, then moving to the next filter and repeating which would result in the same (and last filter) being copied to each sheet.

Instead, you need to filter once, copy to a specific location once, then filter again and copy to only one location. From what I interpreted, the filter and depot number were the same which is why I used the dnum(lngDNUM) to identify the sheet name as well in my code...since the filter itself identifies which sheet it belongs on and thus eliminates the issue of copying one set of data to multiple sheets (each filter would be a separate destination)

Please clarify, do you need to filter once and copy to one destination? (that is, is the filter:copy ratio 1:1 ?)

BexleyManor
07-05-2006, 02:47 PM
do you need to filter once and copy to one destination?

In answer, Yes ! That is exactly what I'm trying to acheive but it has yet evaded me !!

XLGibbs
07-05-2006, 03:47 PM
For lngDNUM = LBound(dnum) To UBound(dnum) ' cycle through depot numbers/filters

With WksSource
.Activate
.Cells(1, 1).AutoFilter Field:=1, Criteria1:=dnum(lngDNUM) 'filter based on top/outer loop
Cells.Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy WkbDest.Sheets("depot " & dnum(lngDNUM)).Cells(1, 1) 'copy to each sheets
.ShowAllData
End With
Next lngDNUM


]If your sheet names are named "Depot 1" and "Depot 3" consistent with your earlier posts, you can simply use one loop and build the sheet names as I have done...otherwise you can do:

For lngDNUM = LBound(dnum) To UBound(dnum) ' cycle through depot numbers/filters

With WksSource
.Activate
.Cells(1, 1).AutoFilter Field:=1, Criteria1:=dnum(lngDNUM) 'filter based on top/outer loop
Cells.Select
Selection.SpecialCells(xlCellTypeVisible).Select
Dim strSheetName as string
Select Case lngDNUM
Case 1
strSheetName = "Sheet Name Here"
Case 2
strSheetName = "Other Sheet Name"
'etc etc
End Select

Selection.Copy WkbDest.Sheets(strSheetName).Cells(1, 1) 'copy to each sheets
.ShowAllData
End With
Next lngDNUM
And do one loop that way...where each filter can be looked at to determine the sheet name. As I stated above, you were looping through all filters, and pasting each one successively into the sheet, resulting in the last filter being applied and pasted to all sheet names.

BexleyManor
07-08-2006, 10:30 AM
Hi, Solution 1 won't work for me because the sheets do have individual site names, I used 'Depot' simply to 'sanitise' the workbook for uploading. Option two looks good though, I'm to try it shortly so will give you some feedback.

Norie
07-08-2006, 11:24 AM
Couldn't this be done using AdvancedFilter?

Which column is the depot in?

Do you want to copy to new sheets or existing sheets?

Norie
07-08-2006, 11:36 AM
Sub DistributeDepots()
Dim wsData As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim rngCrit As Range
Dim LastRowData As Long
Dim I As Long
Set wsData = ActiveSheet

wsData.Rows(1).Insert
For I = 1 To 11
wsData.Range("A1").Offset(, I - 1) = "Field" & I
Next I

Set wsCrit = Worksheets.Add

LastRowData = wsData.Range("A" & Rows.Count).End(xlUp).Row
wsData.Range("A1:A" & LastRowData).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True

Set rngCrit = wsCrit.Range("A2")
While rngCrit.Value <> ""
Set wsNew = Worksheets.Add
wsNew.Name = rngCrit
wsData.Range("A1:K" & LastRowData).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCrit.Offset(-1).Resize(2), CopyToRange:=wsNew.Range("A1"), Unique:=True
rngCrit.EntireRow.Delete
Set rngCrit = wsCrit.Range("A2")
wsNew.Rows(1).Delete
Wend
wsData.Rows(1).Delete
Application.DisplayAlerts = False
wsCrit.Delete
Application.DisplayAlerts = True

End Sub

BexleyManor
07-12-2006, 03:23 PM
Hi Nore, I had a go with your code but the result wasn't what I was looking for.

For the record. I desperately want the list in mainlist.xls to be filtered and then that information copied into either a new workbook (adding a new sheet each time the filter is run) or as it originally started out, copying the filtered data into an existing workbook with existing individually named sheets.

I now have nightmares about this workbook along with developing a nervous tick!! ha ha ha

Will not be beaten by it, no way!!!

BexleyManor
07-12-2006, 03:40 PM
Also... I tried your other option XL Gibbs, with the select case, but I seem to have raised another problem. I'll attempt to explain.

When the code runs and it filters for 'depot' 1 but doesn't find it was raising a subscript error. I shut that up with an on error resume next, but then found that it was putting everything out of sync. Instead of 'depot' 3 filter being pasted to 'depot' 3 sheet it pasted it to 'depot 4' and so on.

My brain aches thinking about this!!

Norie
07-13-2006, 11:40 AM
How did my code not work?

Did it split the data as required?

What it currently does is create new worksheets but it could easily be adapted to move the data to existing workbooks in another workbook.

mdmackillop
07-13-2006, 01:26 PM
This is a simple revision of your code in Post 28. The problem here was your two loops as XLgibbs said. This version will create the sheets in SplitList and do the copying, but I'm running out of resources after 15 sheets.

mdmackillop
07-13-2006, 02:55 PM
This is a revision of Norie's code which will split the data within the same workbook but naming the sheets as per the delclared arrays. If you need it in a separate worbook, then I would do a SaveAs and delete the MainList sheet as the simplest way. This method is not running out of resources.
I never do much filtering, so it's good to see how its done; thanks for that Norie.
Regards
MD

BexleyManor
07-18-2006, 09:27 AM
MD, Norie, XL, I want to kiss you all!! (Entirely platonic you understand?)

Just back from travels and ran MD's code. It seems to be doing the job. I shall put it through it's paces tomorrow with a full 26,000 line list then come back with feedback.

Wow, thanks guys. I never thought I'd get this one sorted. How foolish of me with a forum so damn fine as this!!

Norie
07-18-2006, 09:50 AM
So which code is working?

Is it MD's revision of mine?

mdmackillop
07-18-2006, 10:17 AM
Hi Norie,
Your use of filtering made the difference, I assumed the Depot numbers could be hard coded which simplified getting depot names and I tweaked your code to add the sheet names accordingly
Regards
MD

Norie
07-18-2006, 10:28 AM
MD

The reason I didn't hard code the criteria was because I was thinking what would happen if a new depot was added, or one deleted/changed.

I don't know if that issue was dealt with in previous posts - I'll take a look.:)