Adjust VBA-Excel split code to combine similar tab names

[CharlieP]

I am using the below formula to split each excel tab into it's own workbook. The issue is I utilize Month, YTD and Full Year tabs for distribution; in my case they are broken out by name, so for example it would read "John Smith", "John Smith (2)" and "John Smith (3)" less the quotations. What I would like to do is combine each person's name onto one spreadsheet with all three tabs. I've heard that it can be done by using the first X letters, but more ideally I would like to breakout by exact matching name while excluding numbers and special characters, or if it's easier just cutting off the space and numbers after the name " (2)" and " (3)" as they are the only differences I will have (Excel will not allow for duplicate tab titles so this would have to process through VBA).


Sub Splitbook()
Dim xPath As String
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
xWs.Copy
Application.ActiveWorkbook.SaveAs Filename:=xPath & "" & xWs.Name & ".xlsx"
Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

[Leith Ross]

Hello CharlieP,

I revised your macro. It will scan the worksheets for unique names and associate the like named worksheets with the names. A workbook will be created for each unique name and the associated worksheets will be copied into it.



Sub SplitBook1()


Dim Dict As Object
Dim Key As Variant
Dim n As Long
Dim Wkb As Workbook
Dim Wks As Worksheet
Dim WksObjs() As Variant

Set Dict = CreateObject("Scripting.Dictionary")
Dict.CompareMode = vbTextCompare

'// Associate worksheets with names.
For Each Wks In ThisWorkbook.Worksheets
n = InStrRev(Wks.Name, " ")

If n > 1 Then
Key = Left(Wks.Name, n - 1)
Else
Key = Wks.Name
End If

If Not Dict.Exists(Key) Then
ReDim WksObjs(0)
Set WksObjs(0) = Wks
Dict.Add Key, WksObjs
Else
WksObjs = Dict(Key)
n = UBound(WksObjs) + 1
ReDim Preserve WksObjs(n)
Set WksObjs(n) = Wks
Dict(Key) = WksObjs
End If
Next Wks

'// Create workbooks from names and load with associated worksheets.
For Each Key In Dict.Keys
WksObjs = Dict(Key)
WksObjs(0).Copy
Set Wkb = ActiveWorkbook
For n = 1 To UBound(WksObjs)
Set Wks = WksObjs(n)
Wks.Copy After:=Wkb.Worksheets(Wkb.Worksheets.Count)
Next n
Wkb.SaveAs ThisWorkbook.Path & Key & ".xlsx"
Next Key

End Sub

[CharlieP]

Hi Leath,

I appreciate the response. I tried it out but ran into a couple of issues listed below.

Created two files for each name, first containing pivot table 1 of 3 and second containing pivot tables 2 and 3 of 3 (giving hope as it successfully merged the latter two).

Automatically opening files once saved, wouldn't normally be an issue but as it's usually 40+ files at once it causes issues.

Saving files in folder one level up from current file, but first portion of title uses base folder name (i.e. original file in test folder, new files are saved one level up as TestJohn and TestJohn Smith). - Not a huge issue as I can just create another sub-folder to use and I change the titles anyway.

Thanks for your help,

Charlie

[Leith Ross]

Hello Charlie,

From your first post it appears that you save the new workbook in the same folder as the main workbook. My version of the macro does this. Yet you mention folder levels. Where did you mention that? What does this hierarchy look like?

[CharlieP]

Good Morning Leath,

Yes, for some reason it was placing the name of the folder containing the file used into the name of each new file and saving the files one level up. I put a few test names in and had the below results. The original file is titled "ABC" within the Test2 folder, as you can see the files have saved in the "Test" folder one level up from "Test2" but utilized the text "Test2" before each of the tab names pulled.

Next comes the two files, the files with only a first name contain Pivot Table 1 of 3; the files with full names contain pivot tables 2 and 3 of 3. So it partially worked with consolidating, but ideally would combine all three Pivot Tables onto one file.

23544.

Thanks again for your help!

Charlie


Hello Charlie,

From your first post it appears that you save the new workbook in the same folder as the main workbook. My version of the macro does this. Yet you mention folder levels. Where did you mention that? What does this hierarchy look like?