Solved

using VBA to convert single tab spreadsheet to multiple spreadsheets

Posted on 2016-08-30
27
62 Views
Last Modified: 2016-10-25
Hi,

I have a spreadsheet I'll be creating with provider id as the 1st column and other fields from columns 2-11.  I need to take this spreadsheet and a template spreadsheet and create new spreadsheets from the original, with the template info at the top of each of them.  The name of the new spreadsheets would be the provider #.

Working in Excel 2016.   Would love to be able to do this in batch mode if possible, as there will be a lot of spreadsheets created.

Can anyone give an approach to take that I can start with?

Thanks!

--Ben
0
Comment
Question by:Ben Conner
  • 13
  • 10
  • 2
  • +1
27 Comments
 
LVL 25

Accepted Solution

by:
ProfessorJimJam earned 500 total points
ID: 41776420
you can try this code below.  please see attached.

open the attached file then run the macro or press the Control +SHift +A to run the macro, it will ask you to select the provider column, if it is in first column then select that column and click ok. it will create seperate worksheet for every unique provider# and it will ask you whether you want them in seperate workbook. if you dont want speerate workbook simple click cancel.

try and let me know if you face any difficulties.



Sub SplitBasedOnprovider()
Dim LastRow As Long, LastCol As Integer, i As Long, iStart As Long, iEnd As Long
Dim ws As Worksheet, r As Range, iCol As Integer, t As Date, Prefix As String
Dim sh As Worksheet, Master As String, Folder As String, Fname As String
On Error Resume Next
Set r = Application.InputBox("Click in the column to extract by", Type:=8)
On Error GoTo 0
If r Is Nothing Then Exit Sub
iCol = r.Column
t = Now
Application.ScreenUpdating = False
With ActiveSheet
    Master = .Name
    LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
    LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
    .Range(.Cells(2, 1), Cells(LastRow, LastCol)).Sort Key1:=Cells(2, iCol), Order1:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    iStart = 2
    For i = 2 To LastRow
        If .Cells(i, iCol).Value <> .Cells(i + 1, iCol).Value Then
            iEnd = i
            Sheets.Add after:=Sheets(Sheets.Count)
            Set ws = ActiveSheet
            On Error Resume Next
            ws.Name = .Cells(iStart, iCol).Value
            On Error GoTo 0
            ws.Range(Cells(1, 1), Cells(1, LastCol)).Value = .Range(.Cells(1, 1), .Cells(1, LastCol)).Value
            .Range(.Cells(iStart, 1), .Cells(iEnd, LastCol)).Copy Destination:=ws.Range("A2")
            iStart = iEnd + 1
        End If
    Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Completed in " & Format(Now - t, "hh:mm:ss.00"), vbInformation
If MsgBox("Do you want to save the separated sheets as workbooks", vbYesNo + vbQuestion) = vbYes Then
    Folder = "Select the folder to save the workbooks"
    Folder = GetDirectory(Folder)
    If Folder = "" Then Exit Sub
    Prefix = InputBox("Enter a prefix (or leave blank)")
    Application.ScreenUpdating = False
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> Master Then
            sh.Copy
            Fname = Folder & "\" & Prefix & sh.Name & ".xls"
            If Dir(Fname) <> "" Then Fname = Application.GetSaveAsFilename(fileFilter:="Excel Files (*.xls), *.xls)", _
                Title:=Fname & " exists - select file to save as")
            ActiveWorkbook.SaveAs Filename:=Fname, FileFormat:=56
            ActiveWorkbook.Close
        End If
     Next sh
     Application.ScreenUpdating = True
End If
End Sub

Open in new window

EE.xlsm
0
 

Author Comment

by:Ben Conner
ID: 41776500
Wow.  I couldn't even write it that fast if I had known what to do to start with.

Will give this a shot and let you know.

Thank you!

--Ben
0
 
LVL 25

Expert Comment

by:ProfessorJimJam
ID: 41776515
you are welcome. :)
0
 
LVL 16

Expert Comment

by:Jerry Paladino
ID: 41779562
Professor,
I think the "GetDirectory" procedure is missing from your code to pick the location to save the new workbooks.    Code works well though once that is included.
0
 
LVL 25

Expert Comment

by:ProfessorJimJam
ID: 41779904
Jerry,

if you open the attachment which i posted along with the code, in its module "BrowseSupliment" it does contain the "GetDirectory" function.

what Ben asked can be achieved only up to the 35th line of the code, i provided extra code, in case if Ben wanted to save the sheets into separate workbooks.
0
 
LVL 16

Expert Comment

by:Jerry Paladino
ID: 41779915
My apologies...  I did not download the attachment.  Only executed the code that was in the comment block above.   Again, well done!
0
 
LVL 25

Expert Comment

by:ProfessorJimJam
ID: 41779955
no problem Jerry.

thanks.
0
 

Author Comment

by:Ben Conner
ID: 41779992
Am nearly complete creating the spreadsheet this will run against.  Looking at the code, I think I can eliminate the first half of it where it splits the single tab into multiple tabs prior to shipping them out to different spreadsheets.  I just did that in the application I wrote instead.  

Should be able to test it later today.
0
 

Author Comment

by:Ben Conner
ID: 41779994
BTW, this will end up with 4000-4500 tabs.  That won't be a problem will it?
0
 
LVL 25

Expert Comment

by:ProfessorJimJam
ID: 41780009
Hi Ben,

Number of worksheet limit is dependent upon available memory . Do you have 32 bit or 64 bit office?
0
 

Author Comment

by:Ben Conner
ID: 41780030
It's 64 bit, Excel 2016
0
 

Author Comment

by:Ben Conner
ID: 41780033
And each tab will be fairly small, about 8 columns and max 100 rows.
0
 

Author Comment

by:Ben Conner
ID: 41780036
Oh.  Wait.  I won't be running it, someone else will.  I don't know what their footprint looks like.  Oops.
0
How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

 
LVL 25

Expert Comment

by:ProfessorJimJam
ID: 41780192
let them try, and see it might work.
0
 

Author Comment

by:Ben Conner
ID: 41780622
Just found they are on Excel 2010, 32 bit version.
0
 

Author Comment

by:Ben Conner
ID: 41788504
Trying the code above now that I have the spreadsheet created and am getting an unknown function error for GetDirectory().  I don't see it in Excel 2016.   Should I use Activeworkbook.Path or something similar?  The error was on line:

    Folder = GetDirectory(Folder)

--Ben
0
 
LVL 25

Expert Comment

by:ProfessorJimJam
ID: 41788631
Hi Ben,

yiu are getting that error because probably you did not copy the whole code from the attached workbook, please open the attached workbook that I posted in earlier post and there is also the UDF in its module "BrowseSupliment"
Once you copy and paste that code with the existing code then you will not see error
0
 

Author Comment

by:Ben Conner
ID: 41788643
Oops.  Missed the xlm attachment.  My bad.  Thanks!

--Ben
0
 

Author Comment

by:Ben Conner
ID: 41788687
Just ran the spreadsheet in debug mode.  Very nice!  The app I developed already does the first part--splitting them out into separate tabs, so I can just lift the latter half of it and let it rip.

Thanks very much!

--Ben
0
 

Author Closing Comment

by:Ben Conner
ID: 41788690
Excellent example of splitting a sheet in a spreadsheet into multiple spreadsheets in an automated fashion.
0
 
LVL 25

Expert Comment

by:ProfessorJimJam
ID: 41788736
You are welcome Ben, I am glad I was able to help
0
 

Author Comment

by:Ben Conner
ID: 41789412
This is probably a separate question, but can this be automated?  The client wants to be able to call this in an automated .bat file.  Something like:

<path to excel>  <spreadsheet> <path to macro> <path to destination folder> <split column> <# of title rows>

I'm not even sure this is possible.  ?

--Ben
0
 
LVL 25

Expert Comment

by:ProfessorJimJam
ID: 41789428
yes it is a separate question and it not related to Excel or VBA. i suggest you open a question in the top of related window scripts .
0
 

Author Comment

by:Ben Conner
ID: 41789520
Thanks!  Will do.

--Ben
0
 

Expert Comment

by:c4looney
ID: 41844458
Professor,

I have 64 bit, Excel 2016 and receive a Compile error when I try to open your xslm attachment.  How do I fix that?

--Christine
0
 
LVL 25

Expert Comment

by:ProfessorJimJam
ID: 41844654
Can you please share on which line of the code the highlighter of debugger stops?  I
0
 

Expert Comment

by:c4looney
ID: 41859250
Hi Professor, I got busy on another project and am now back to this one.  The section highlighted is this:
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
  Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) _
  As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Thank you for your help!!
0

Featured Post

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

INDEX and MATCH can be used to great effect to replace HLOOKUP and VLOOKUP as it does not have the limitation of needing the data to be sorted so that the reference value is in the first column or row. It also has the ability to perform a bi-directi…
Modern/Metro styled message box and input box that directly can replace MsgBox() and InputBox()in Microsoft Access 2013 and later. Also included is a preconfigured error box to be used in error handling.
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…

706 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

16 Experts available now in Live!

Get 1:1 Help Now