Sorry should be:
[VBA]
Set WkbDest = Workbooks("Customer Split File.xls")
[/VBA]
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.
Sorry should be:
[VBA]
Set WkbDest = Workbooks("Customer Split File.xls")
[/VBA]
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.
If you have posted the same question at multiple forums, please read this IMPORTANT INFO.
Please use the thread tools to mark your thread Solved
Please review the Knowledge Base
for samples and solutions , or to submit your own!
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??
Try this slightly revised version. I'm finding that my PC runs out of resources before the full array is stepped through.
[VBA]
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
[/VBA]
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
MD's code is revised from the original which creates a new workbook...
the error you describe is this:
[vba]
Selection.Copy WkbDest.Sheets("Depot " & dnum).Cells(1, 1)
[/vba] which should be
[vba]
Selection.Copy WkbDest.Sheets("Depot " & dnum(lngDNUM)).Cells(1, 1)
[/vba]
Sorry for the error there..
If you have posted the same question at multiple forums, please read this IMPORTANT INFO.
Please use the thread tools to mark your thread Solved
Please review the Knowledge Base
for samples and solutions , or to submit your own!
Hi Pete,
I ran into an error here, hence my change.
Regards
MD
[vba]
For lngDNUM = LBound(dnum) To UBound(dnum)
Workbooks.Add ' add a workbook
WkbDest.Name = "Depot " & dnum(lngDNUM)
[/vba]
Edit: Tried it again, and no error, but obviosly a different result!
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
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.
[VBA]
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[/VBA]
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
Hi Bexley,
Can you sanitise and post your workbook?
Regards
MD
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
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??
Anyone with any fresh ideas for this little beauty??
It's still driving me up the wall!!!
Comments applicable perhaps
[vba]
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[/vba] '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 ?)
If you have posted the same question at multiple forums, please read this IMPORTANT INFO.
Please use the thread tools to mark your thread Solved
Please review the Knowledge Base
for samples and solutions , or to submit your own!
In answer, Yes ! That is exactly what I'm trying to acheive but it has yet evaded me !!do you need to filter once and copy to one destination?
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.
If you have posted the same question at multiple forums, please read this IMPORTANT INFO.
Please use the thread tools to mark your thread Solved
Please review the Knowledge Base
for samples and solutions , or to submit your own!
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.
Couldn't this be done using AdvancedFilter?
Which column is the depot in?
Do you want to copy to new sheets or existing sheets?
[vba]
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
[/vba]
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!!!
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!!
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.
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.
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
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
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
To help indent your macros try Smart Indent
Please remember to mark threads 'Solved'
Posting Permissions
Reply With Quote
