Consulting

Results 1 to 8 of 8

Thread: Combine common worksheet names when splitting a file

  1. #1
    VBAX Regular
    Joined
    Jan 2019
    Location
    Baltimore, MD
    Posts
    8
    Location

    Exclamation Combine common worksheet names when splitting a file

    Refreshing a persistent issue. I am using the below formula to split each excel tab into it's own workbook, and that works great. The issue is I utilize Month, YTD and Full Year tabs for each recipients 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 for MTD, YTD and Full Year respectively. What I would like to do is combine each person's 3 worksheets onto one workbook. It appears there are two methods to do this:
    1) Use a certain number of characters for it then all like names will be converted to one workbook (i.e. 8 characters would be "John Smi" which would capture all 3 but may fail with two people named Gregory).
    2) Using a code that excludes numbers and special characters (i.e. John Smith (3) = John Smith) - here i'm also unsure if the space after the name would cause an issue. This option is more ideal for dealing with both very long first names and very short first + last names.

    Any thoughts or insight would be greatly appreciated, as I am currently splitting my file with the below formula and the manually copying three workbooks together. Doing this 70 times each month is a burden. End goal is having one workbook for each common name with a Month, YTD and Full Year tab (bonus would be including a data tab at the end based off of the full year tab).

    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

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,443
    Location
    Why do you need separate tabs/workbooks. In my experience it is better to hold all of the data together with the defining attributes (name, date, amount etc). and then use some analysis tool to view whatever you want to vies.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    VBAX Expert
    Joined
    Sep 2016
    Posts
    788
    Location
    Sub test()
        Dim dic As Object
        Dim ws As Worksheet
        Dim s As String
        
        Set dic = CreateObject("scripting.dictionary")
        
        For Each ws In Worksheets
            s = ws.name
            If s Like "* (?)" Then
                dic(Left(s, Len(s) - 4)) = True
            End If
        Next
        
        MsgBox Join(dic.keys, vbLf)
        
    End Sub

  4. #4
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    The issue is I utilize Month, YTD and Full Year tabs for each recipients 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 for MTD, YTD and Full Year respectively.
    So... Does that mean the "John Smith" is actually the Full Year report/tab?
    "John Smith", "John Smith (MTD)" and "John Smith (YTD)"
    Or
    "John Smith", "John Smith(MTD)" and "John Smith(YTD)"
    Or
    "John Smith", "John Smith MTD" and "John Smith YTD"



    I soooo much dislike spreadsheet designers that don't use proper patterns. It makes life so complicated.

    I'm just gonna a save this here in case I decide to come back to it.
    Option Base 1
    
    Sub SplitReportsIntoNewBooks()
    'This assumes that all sheets with the same Client Name are next to each other
    'This assumes that there is no spaces(s) between a Client Name and the Open
    '   Parentheses around the Report Category
    Dim Clientname As String
    Dim Category As String
    Dim Extension As String
    Dim List As Variant
    Dim Tmp As Variant
    Dim WkSht As Worksheet
    Dim ShtName As String
    Dim SINW As Long
    Dim i As Long
    
    Extension = ".xlsx"
    ReDim List(Worksheets.Count, 3)
    
    With Application
       SINW = .SheetsInNewWorkbook
       .SheetsInNewWorkbook = 3
       .EnableEvents = False
       .DisplayAlerts = False
    End With
    
    For i = 1 To Worksheets.Count
       Tmp = Split(Worksheets(i).Name, "(") 'Will Error on "John Smith"
       ShtName = Tmp(1)
       Category = Left(Tmp(2), 3)
    
    'Make new book
    'Add Sheets i + 1 + 2 increment i
    'rename sheets
    'Save and close
    
    Next i
    
    
    With Application
       .SheetsInNewWorkbook = SINW
       .EnableEvents = True
       .DisplayAlerts = True
    End With
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  5. #5
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    You have a number of assumptions about WS names, etc.


    Option Explicit
    
    
    Sub SplitWorkbook()
        Dim sNames As String, sName As String
        Dim ws As Worksheet
        Dim aryNames As Variant
        Dim wbName As Workbook
        Dim iName As Long
        
        Application.ScreenUpdating = False
        
        'build string of WS names that do NOT end with a )
        For Each ws In Worksheets
            If Right(ws.Name, 1) <> ")" Then
                sNames = sNames & ws.Name & ";"
            End If
        Next
            
        If Right(sNames, 1) = ";" Then sNames = Left(sNames, Len(sNames) - 1)
        
        'put WS base names into array
        aryNames = Split(sNames, ";")
        
        
        For i = LBound(aryNames) To UBound(aryNames)
            
            'copy base WS to make new WB
            Worksheets(aryNames(i)).Copy
            Set wbName = ActiveWorkbook
            
            'add the (2) and (3) WS to new WB
            ThisWorkbook.Worksheets(aryNames(i) & " (2)").Copy After:=wbName.Sheets(1)
            ThisWorkbook.Worksheets(aryNames(i) & " (3)").Copy After:=wbName.Sheets(2)
    
    
            'build the new WB name = this path + base name
            sName = ThisWorkbook.Path & Application.PathSeparator & aryNames(i) & ".xlsx"
            
            'delete if it exists
            Application.DisplayAlerts = False
            On Error Resume Next
            Kill sName
            On Error GoTo 0
            Application.DisplayAlerts = True
    
    
            'save new WB and close
            wbName.SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator & aryNames(i) & ".xlsx", FileFormat:=xlOpenXMLWorkbook
        
            ActiveWindow.Close
        Next i
    
    
        Application.ScreenUpdating = True
    
    
        MsgBox "Done"
    
    
    End Sub

    My crystal ball tells me the next thing will be VBA to email each WB to the designated person
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  6. #6
    VBAX Regular
    Joined
    Jan 2019
    Location
    Baltimore, MD
    Posts
    8
    Location
    Quote Originally Posted by xld View Post
    Why do you need separate tabs/workbooks. In my experience it is better to hold all of the data together with the defining attributes (name, date, amount etc). and then use some analysis tool to view whatever you want to vies.
    The data is all held together and shown on their data tabs, what I am doing is creating three separate pivot tables to give quick and easy views for the recipients (these are people with very, very limited excel knowledge so they won't even know how to use the basic report filters).

  7. #7
    VBAX Regular
    Joined
    Jan 2019
    Location
    Baltimore, MD
    Posts
    8
    Location
    It means that "John Smith" is MTD, "John Smith (2)" is YTD and "John Smith (3)" is Full Year, I just leave MTD as the recipients name for ease and manually change the 2nd and third tab names to "YTD" and "Full Year" and double-click the total on the Full Year tab to create a data tab - End result is 4 tabs (John Smith [MTD tab], YTD, Full Year, and Data). Unfortunately the output of the files will automatically be the name as I add name to the report filters to separate the Pivot Table into separate worksheets, but that's fine. Yeah it came up with an error but I think it's on the right track. The tab names that repeat are separate, as the original file will be the same format as the end file (just not broken out), so excel outputs names A-Z for MTD, then YTD, then Full Year. There is also a space that excel enters prior to the Open Parenthesis. I appreciate you lookinig into it!

  8. #8
    VBAX Regular
    Joined
    Jan 2019
    Location
    Baltimore, MD
    Posts
    8
    Location
    This worked perfectly Paul! A wizard indeed, thank you so much! I cannot state the dread it was manually combining these three files 70 times every single month. It seemed to handle the name length issue just fine as well. I really appeciate the help!

    Quote Originally Posted by Paul_Hossler View Post
    You have a number of assumptions about WS names, etc.


    Option Explicit
    
    
    Sub SplitWorkbook()
        Dim sNames As String, sName As String
        Dim ws As Worksheet
        Dim aryNames As Variant
        Dim wbName As Workbook
        Dim iName As Long
        
        Application.ScreenUpdating = False
        
        'build string of WS names that do NOT end with a )
        For Each ws In Worksheets
            If Right(ws.Name, 1) <> ")" Then
                sNames = sNames & ws.Name & ";"
            End If
        Next
            
        If Right(sNames, 1) = ";" Then sNames = Left(sNames, Len(sNames) - 1)
        
        'put WS base names into array
        aryNames = Split(sNames, ";")
        
        
        For i = LBound(aryNames) To UBound(aryNames)
            
            'copy base WS to make new WB
            Worksheets(aryNames(i)).Copy
            Set wbName = ActiveWorkbook
            
            'add the (2) and (3) WS to new WB
            ThisWorkbook.Worksheets(aryNames(i) & " (2)").Copy After:=wbName.Sheets(1)
            ThisWorkbook.Worksheets(aryNames(i) & " (3)").Copy After:=wbName.Sheets(2)
    
    
            'build the new WB name = this path + base name
            sName = ThisWorkbook.Path & Application.PathSeparator & aryNames(i) & ".xlsx"
            
            'delete if it exists
            Application.DisplayAlerts = False
            On Error Resume Next
            Kill sName
            On Error GoTo 0
            Application.DisplayAlerts = True
    
    
            'save new WB and close
            wbName.SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator & aryNames(i) & ".xlsx", FileFormat:=xlOpenXMLWorkbook
        
            ActiveWindow.Close
        Next i
    
    
        Application.ScreenUpdating = True
    
    
        MsgBox "Done"
    
    
    End Sub

    My crystal ball tells me the next thing will be VBA to email each WB to the designated person

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •