Solved

Copy section of workbook and create new workbook with workbook name from file

Posted on 2013-01-22
48
456 Views
Last Modified: 2013-02-01
I'm new to VBA and what I'm try to do is this
I have a workbook with one sheet that has 3 rows of headers and 30000 rows of data with no blanks
The data  in column A has the client name. The Client name alwys starts the row so there are many client names the same in Column A. the data in column b to n is various and can take many rows
So for each client section I would like to move the data from column A :N to its own work book on Drive:T with the client name as the name of the file.

 Is this possible?
0
Comment
Question by:llawrenceg
  • 22
  • 20
  • 6
48 Comments
 
LVL 45

Expert Comment

by:aikimark
ID: 38808737
added Excel zone

================
@llawrenceg

It would benefit the experts if you posted an example of the first 100 rows of the workbook.

aikimark -- zone advisor
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38809047
Hi, llawrenceg.

Please see attached. A couple of point.
(1) Please change..
xOutput = "T:\"
...to reference your appropriate folder. (don't forget to include a trailing "\".)
(2) If the file already exists then the date and time and a number is appended to give a new, unique file name.
(3) It is assumed that the records are sorted by file name. If not then multiple files will be created for clients.

The code is...
Option Explicit

Sub Extract_Clients()
Dim i As Long
Dim xStart As Long
Dim xBook As Workbook
Dim xDest As Workbook
Dim xSheet As Worksheet
Dim xLast_Row As Long
Dim xDir As String
Dim xClient As String
Dim xOutput As String
Dim StartTime  As Variant

StartTime = Timer()

xOutput = "T:\Client_Extract\"

Set xBook = ActiveWorkbook
Sheets("Sheet1").Activate
Set xSheet = ActiveSheet
If xSheet.UsedRange.Rows.Count < 1 Then Debug.Print "!?" 'Force Excel to recalculate the last cell.
xLast_Row = xSheet.Range("A1").SpecialCells(xlLastCell).Row

If xLast_Row < 4 Then
    MsgBox ("No data found - run cancelled.")
    Exit Sub
End If

xStart = 4

Application.ScreenUpdating = False
    
    With xSheet
    
        For i = 4 To xLast_Row
        
            xClient = .Cells(i, 1)
        
            If xClient <> .Cells(i + 1, 1) Then
                
                Set xDest = Workbooks.Add
                
                .Range(.Cells(1, 1), .Cells(3, 14)).Copy
                ActiveSheet.Paste
                Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                .Range(.Cells(xStart, 1), .Cells(i, 14)).Copy Destination:=Range("A4")
                
                Range("B4").Select
                ActiveWindow.FreezePanes = True
                
                ActiveSheet.Shapes("Extract Client").Delete
                
                xDir = Dir(xOutput & xClient & ".xlsx")
                If xDir = "" Then
                    xDir = xOutput & xClient & ".xlsx"
                Else
                    xDir = xOutput & xClient & "_" & Format(Now(), "yyyymmdd_hhnnss") & "_" & i & ".xlsx"
                End If
                    
                xDest.SaveAs Filename:=xDir, FileFormat:=xlOpenXMLWorkbook
                If Dir(xDir) = "" Then
                    MsgBox ("Save of """ & xDir & """ failed - run cancelled.")
                    Exit Sub
                End If
                xDest.Close savechanges:=False
                
                xStart = i + 1
            
            End If
            
        Next i
        
    End With

Application.ScreenUpdating = True

MsgBox ("Run completed in " & Format(Timer - StartTime, "#,##0.0") & " seconds)")

End Sub

Open in new window

Regards,
Brian.
Extract-Clients.xlsm
0
 

Author Comment

by:llawrenceg
ID: 38810857
Attached is a sample file.
When copying the data set to the new data with a new name  I need the client name in the new workbook name and a new workbook  for each client
example.xls
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38810977
llawrenceg,

Did you try my file?

Brian.
0
 

Author Comment

by:llawrenceg
ID: 38811069
xDest.SaveAs Filename:=xDir, FileFormat:=xlOpenXMLWorkbook this piece of code is giving me a viarable undefined error
also
 Set xDest = Workbooks.Add
The code skips the whole section after this piece so no new workbook is setup oropened and nothing is copied
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38811124
llawrenceg,

Apologies, I missed the bit about 2003.

The file is now an xls and save the files in the same format. Don't forget to update the folder location.

Regards,
Brian.Extract-Clients.xls
0
 

Author Comment

by:llawrenceg
ID: 38811281
still getting an error" VARIABLE NOT DEFINED

                xDest.SaveAs Filename:=xDir, FileFormat:=xlExcel8
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38811440
llawrenceg,

Please replace the line by the following...
xDest.SaveAs Filename:=xDir, FileFormat:=56

(If that fails, please try the following...
xDest.SaveAs Filename:=xDir
...and let me know what happens.

Thanks,
Brian.
0
 

Author Comment

by:llawrenceg
ID: 38811589
If xClient <> .Cells(i + 1, 1) Then
nothing happens. It jumps past everything after this code

xClient = 1 and Cells(i+1,1) =1 also so what happens if they are the same
0
 

Author Comment

by:llawrenceg
ID: 38811650
xDest.SaveAs Filename:=xDir, FileFormat:=56  failed

(If that fails, please try the following...
xDest.SaveAs Filename:=xDir
worked
0
 

Author Comment

by:llawrenceg
ID: 38811680
ActiveSheet.Shapes("Extract Client").Delete

Runtime  error
The item with the specified name was not found
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38811804
llawrenceg,

Were you running my file? If not then, for the test, please comment out this line.

If you were running my file then please save the new file and post it here.

Thanks,
Brian.
0
 

Author Comment

by:llawrenceg
ID: 38811937
It Works It Works
0
 

Author Comment

by:llawrenceg
ID: 38811946
How many rows should I try for real. Will 100 be ok or can I go to 300
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38812069
llawrenceg,

Unless you've got a huge number of Clients and/or a very old PC, I'd go for broke - close any other files in Excel, start processing your entire file and go make a cup of tea (at a pinch, coffee). I'd expect the run to be finished before your cup is half-empty.

Regards,
Brian.
0
 

Author Comment

by:llawrenceg
ID: 38812112
Here is the file back with the adjustments
Copy-of-Extract-Clients.xls
0
 

Author Comment

by:llawrenceg
ID: 38812121
My Quick run of 300 rows took 34.3 seconds
Can I take the button off and just run it from tools macros?
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38812345
llawrenceg,

Ok, lots to think about...
(1) Am i correct that the changes in your file are...
     (A) The delete of the button has been dropped?
     (B) The SaveAs line is now...
           xDest.SaveAs Filename:=xDir
(2) That SaveAs line cause problems for me - the file is saved in xlsx format. (That's the Excel default for 2010, but not the default I have set.)
Assuming that you can open one of the output files without an error and that you won't be running the macro on a version higher than 2003, then your change is probably OK.
(3) On my PC, it took 45 seconds for 180 clients in 543 rows. Please note that I had the VBE screen (probably headed something like "Visual Basic for Applications") closed and the output folder was not open in Explorer. The time-consuming bit is the number clients - the same records but as a single client took 0.4 seconds!
(4) Yes, you can drop the button and use the menu instead.

How many rows and how many clients have you got?

Thanks,
Brian.
0
 

Author Comment

by:llawrenceg
ID: 38812432
Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Paste special of range class failed
0
 

Author Comment

by:llawrenceg
ID: 38812455
The program is creating the initial file on my computer  then renames the workbook and asks if I want to replace the contents of the existing cells??
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38812460
llawrenceg,

It looks like something interfered with the Clipboard from the copy two lines earlier. (Please note that the Paste on the line immediately preceding this didn't give an error.)

Any chance you did a copy in another application? I'd make a note of which client the error occurred on, delete the output files and start again.

Regards,
Brian.
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38812474
llawrenceg,

Apologies, crossing posts. Please see my last post.

If the "replace" message occurs in the re-run, please post a screenshot here.

Thanks,
Brian.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 38812527
use a
          Application.DisplayAlerts = False
statement to suppress warnings.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 38812572
I think Brian's solution is pretty good.  If performance is still a problem, you might want to time different parts of the loop and consider the following:
* use a template workbook that already has the first three rows set and the panes frozen
* use only one new workbook, clearing the row 4+ contents before transferring the client data from the big workbook, and doing a Save As (new name), and not close the workbook.

Also, adding a DoEvents and getting rid of the clipboard object will allow this process to run in the background without interfering with your other work.

If you need to check on the progress, you can add an
     Application.Statusbar = xClient
statement.
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 26

Expert Comment

by:redmondb
ID: 38813085
akimark, thanks for the kind words.

As usual, you make a lot of good points, but I presume that you meant that the DisplayAlerts should be suppressed only for the PasteSpecial? I'm assuming that the user wants to be informed if there's data missing from an output file.

BTW, the clash between the user and the macro over the use of the clipboard is something I've encountered on a few occasions (although less often than I would expect). Other than keeping my paws off the keyboard,  and mouse, I've not found a solution. Are you aware of one?

Regards,
Brian.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 38813108
@Brian

1. If at all possible, avoid the use of the clipboard in VBA code
2. Always do an Appactivate before every clipboard paste or Sendkeys operation

The suppression of alerts and warnings can be for the entire code, not just PasteSpecial.  I'm not sure how a file could be empty, but if you need to let the user know, then persist that data in a separate worksheet or text file.  If only a few messages accumulate, then you might consider a msgbox for the error message(s) display.  I will frequently add error messages to a collection object variable and then display them to the user appropriately or return them to the calling code.
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38813193
aikimark,

If at all possible, avoid the use of the clipboard in VBA code
Well, yes, but it's an integral part of PasteSpecial!

Always do an Appactivate before every clipboard paste or Sendkeys operation
Before a SendKey - definitely. Before a clipboard paste - definitely not! (I'm not disagreeing with you, just saying that I never do it.) So, you'd do an AppActivate before every PasteSpecial? And that helps to protect the clipboard from other applications?

The suppression of alerts and warnings can be for the entire code, not just PasteSpecial.
A complete no-no for me. I only enable DisplayAlerts (and "Resume Next") for the absolute minimum number of lines. Other than for very specific cases, I don't tolerate silent failures - and certainly not when a macro is under development.

I'm not sure how a file could be empty
Nor I, but if there's any chance of that happening then I want an error displayed! Because Excel will do this for free, it doesn't normally make economic sense to write code for occurrences that are unlikely to happen in the life of the macro.

Regards,
Brian.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 38813253
For your use of pastespecial (xlPasteColumnWidths), you have alternatives
1. iterate the columns programmatically setting the column widths
2. use a template workbook
3. only use the pastespecial once (outside of the loop) and reset/clear and repopulate the non-header rows

The use of Appactivate prevents the user from pasting the contents from another application as well as prevents the user from pasting the clipboard contents generated by my macro.

I'm not suggesting this for development.  As far as I can tell, the code works and the warning dialog is expected.  I'm not suggesting you hide errors from the user, just delay displaying them until you are finished.  Work around errors.  Log/Note errors.  Only stop on the most severe errors requiring user actions.
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38813917
aikimark,

For your use of pastespecial (xlPasteColumnWidths), you have alternatives
:)

The use of Appactivate prevents the user from pasting the contents from another application as well as prevents the user from pasting the clipboard contents generated by my macro.
Yes, I see what you're saying now! That would certainly, strongly encourage the user to stay away while such a macro was running and continuously stealing focus.

Regards,
Brian.
0
 

Author Comment

by:llawrenceg
ID: 38816042
Could the replace content message I'm getting be due to the use of Active Workbook as opposed to This Workbook .

I watch the program work , I have an original iwith the data and then one temp workbook created and  then a third  workbook created  that is saved. The Message comes u[ after the temp workbook is created and before the third workbook is saved. All three workbooks are open at the same tme and is the program loosing  which  worksheet is Active??
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38816075
llawrenceg,

Did the "replace" message occur in the re-run? If so, please post the screenshot.

is the program loosing  which  worksheet is Active?
Unlikely, it's run repeatedly without error on my PC. There just some detail that's different in our setups - roll on the screenshot!

Thanks,
Brian.
0
 

Author Comment

by:llawrenceg
ID: 38816401
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38816545
Excellent, thanks llawrenceg!


Assuming that you don't already have a Client file open when the macro starts (and that none of your Client Names are the same as the name of the file running the macro) then I suspect that the SaveAs issues we were havig earlier wer enot completely resolved.

I've no 2003 Excel, but I have access to Excel 2000 - I'll use that to check the format of the command.

Back in 10.

Regards,
Brian.
0
 

Author Comment

by:llawrenceg
ID: 38816606
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38816609
llawrenceg,

OK, the magic format is -4143. Please try the attached - for the first run please only change the following line...
xOutput = "T:\Client_Extract\"

I need to know whether you got an error and whether you could open any saved files without error.

Thanks,
Brian.Extract-Clients-V2.xlsm
0
 

Author Comment

by:llawrenceg
ID: 38816621
The only file I have open on my desk I do not use while using this file.is running. This file creates the other files showing in the screen shots

Could any of the probem be that the T:\\Drive: is a Network drive. Saving to network drives I've heard can be problmatic
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38816687
llawrenceg,

Yes that's worth trying - after we've seen what happens with V2!

Thanks,
Brian.
0
 

Author Comment

by:llawrenceg
ID: 38820245
Sorry for the delay, Our network is such that you are limited in the number of times at one site in a day


your code as is runs perfect right away. .
However , when I copy over my headers and data for the complete page and run the code  I get this:




"Do you want to replace contents"

ERROR

Paste Special Method  of Range Class failed

Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38820324
llawrenceg,

I'm going to try similar code in Excel 2000 (unfortunately I can't copy anything in to that PC). In the meantime, you might try commenting out the PasteSpecial and check that everything else is OK.

Our network is such that you are limited in the number of times at one site in a day
Ouch!

Regards,
Brian.
0
 
LVL 26

Accepted Solution

by:
redmondb earned 500 total points
ID: 38820517
llawrenceg,

Unfortunately "xlPasteColumnWidths" was only added after Excel 200, so I couldn't test my code.

"If at first you don't succeed, try, try, and try again... and then give up - no point in being a fool about it."
The attached doesn't used PasteSpecial, instead it simply loops through the columns, setting each one of them equal to the source file.

Regards,
Brian.Extract-Clients-V3.xlsm
0
 

Author Comment

by:llawrenceg
ID: 38820833
Brian:
Again  
yoo data worked perfectly
When I copied my data over yours the process was the same as previous but without the Display Alerts
It starts off creating the file and calling it Book 1 then it copies ver and the new file is the client name and then it is saved to the drive
and the process repeats with Book 2 and the second client name and soon and so on

But it does work and for that I thank you and apologise for taking so much of your time
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38821010
Thanks, llawrenceg.

(1) The apologies are mine, my memories of Excel 2003 are obviously weaker than I had thought.
(2) "It starts off creating the file and calling it Book 1"
How did you know this - isn't ScreenUpdating turned off?
(3) "But it does work"
Damning with faint praise?! Is anything happening that you don't like?

Some experts like their questions closed ASAP, I prefer them to be left open until the client is fully satisfied. (Selfish reasons really, it's must easier to track new posts from an open question than a closed one.)

Regards,
Brian.
0
 

Author Comment

by:llawrenceg
ID: 38822286
Brian:
The Screen Updating is not working even though the code is there

"Application.ScreenUpdating = False"
Question:
Why freeze the panes?
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38822365
llawrenceg,

The Screen Updating is not working even though the code is there
I've never seen that. In case something in your Excel is interfering, Please recycle Excel, run the blue button macro in the attached,save the results then run the original V3 (i.e. the only change being to the xOutput string). Assuming that ScreenUpdating still isn't working then post the updated List.

Why freeze the panes?
It's almost an automatic setting for me - if it's got a header row then it gets frozen. (By chance, the attached isn't frozen - but that's only because it has header rows throughout the sheet.
Obviously, just delete the row if you don't want it, but I'd love to know why you don't want it!

Regards,
Brian.

Edit: Attachment included...List-Open-WorkBooks-Add-Ins-etc.xls
0
 
LVL 45

Expert Comment

by:aikimark
ID: 38822683
I freeze panes as well, especially with many rows and many columns.
0
 

Author Comment

by:llawrenceg
ID: 38827830
Brian:
I copied the code into a new module and the screenupdating worked perfectly


I was just curious about the freze panes code as I had never seen anyone do that .
But then you are copying the headers separately as well and I have not see that. Ususally I see everythng  is copied over a once
Perfect job. Thank yo
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38827911
llawrenceg,

But then you are copying the headers separately as well and I have not see that.
Because normally it's a single contiguous range, whereas here (for all except the first client)  it's two separate blocks. It could be done in a single operation, but at small cost in efficiency, the existing code is easier to understand and change.

I copied the code into a new module and the screenupdating worked perfectly
Edit: I'm glad (and relieved!) to hear that, but I don't understand what happened earlier. If that command ran but update activity displayed then either something else interfered or you've got a corrupt file.

Regards,
Brian.
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38843867
Thanks, llawrenceg,.
0

Featured Post

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

Suggested Solutions

Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
My experience with Windows 10 over a one year period and suggestions for smooth operation
Learn how to create and modify your own paragraph styles in Microsoft Word. This can be helpful when wanting to make consistently referenced styles throughout a document or template.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now