Announcement

Collapse
No announcement yet.

Create multiple excel files according to category from master excel file

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Create multiple excel files according to category from master excel file



    Hi

    This is my first post and I am a vba newbie. Read the rules and tried to search the forum for the answer but cannot seem to find it. So I shall try to explain what I wish to achieve in hope that the experts will support me.

    I have a master excel file which consists of multiple rows of data. Column A of the master file contains the product category. I wish to create a macro which goes through the various product categories and for each different category it creates a new excel file with only the row data for that particular category. The newly created filenames would be in this format "Product Category Name + today's date.xls".

    Example:

    masterfile.xls
    COLUMN A
    Product 1
    Product 1
    Product 2
    Product 2
    Product 2
    Product 3
    Product 3

    ... once the macro is run these three files are created

    Product1 20-04-11.xls
    COLUMN A
    Product 1
    Product 1

    Product2 20-04-11.xls
    COLUMN A
    Product 2
    Product 2
    Product 2

    Product3 20-04-11.xls
    COLUMN A
    Product 3
    Product 3

    Any help will be greatly appreciated.

    Thanks

    Alex

  • #2
    Re: VBA - Create multiple excel files according to category from master excel file

    Try this...
    Code:
    Sub SplitSheet()
       
       Dim lngRow As Long
       Dim lngOtherRow As Long
       
       Dim strTemp As String
       Dim wb As Excel.Workbook
       Dim wbX As Excel.Workbook
        
       '// Loop through used range in Column A
       '// Note Absolute references to Sheet1 - change as needed
       For lngRow = 1 To Sheet1.UsedRange.Rows.Count
          
          '// Make up the Product/Date string
          strTemp = Sheet1.Cells(lngRow, 1) & Format$(Date, " dd-mm-yy")
          
          '// Loop through all open workbooks
          For Each wbX In Application.Workbooks
             
             '// If the First sheet is named same as Product/Date pair
             If wbX.Sheets(1).Name = strTemp Then
                '// Use this workbook
                Set wb = wbX
                '// No more checking to do - Exit
                Exit For
             End If
          Next
          
          '// If wb is still nothing after getting to here then
          '// the workbook for this product/date does not exist.
          If wb Is Nothing Then
             '// Add it
             Set wb = Application.Workbooks.Add
             '// Name sheet1
             '// If this seems strange it's because a WorkBook cannot be
             '// Named until it's saved. So Sheet1.Name is used as the
             '// marker
             wb.Sheets(1).Name = strTemp
          End If
          
          '// See how many rows used
          lngOtherRow = wb.Sheets(strTemp).UsedRange.Rows.Count
          
          '// If the calculated max row has data, then use next row
          '// If the workbook is empty, Usedrange still returns 1, so an adjustment
          '// would have to be made whichever way it's done.
          If wb.Sheets(strTemp).Cells(lngOtherRow, 1).Value <> "" Then
             lngOtherRow = lngOtherRow + 1
          End If
          
          '// Copy value from source sheet to new wb
          wb.Sheets(strTemp).Cells(lngOtherRow, 1).Value = Sheet1.Cells(lngRow, 1).Value
          
          '// Delete reference to other workbook
          '// (Does not affect the workbook itsself.
          Set wb = Nothing
       
       '// Go around and do it all again
       Next
    End Sub
    Note - As workbooks cannot be named until they are saved, this does not save using the naming convention you asked for. Read the comments in the code

    Comment


    • #3
      Re: VBA - Create multiple excel files according to category from master excel file

      Hi cytop

      Thanks for your quick reply. I tried the code and it almost does the job perfectly, but I would like to tweak it a bit further if possible. Unfortunately I'm more of a newbie than I thought and I need to ask again for support on the following.

      1) How can I make it copy all the data in the row and not just the data in colomn A?

      2) The first row is a title row and I would like it included in all the files that are created.

      3) I found this code which creates a copy of the file, with the filename (Cell A2 + today's date). I was wondering if this can somehow be included and changed a bit to work like I explained in my original post.

      Code:
      Sub test2()
      '
      ' test2 Macro
      '
      'Saves filename as value of A1 plus the current date
      Dim newFile As String, fName As String
      'Don't use "/" in date, invalid syntax
      fName = Range("A2").Value
      'Change the date format to whatever you'd like, but make sure it's in quotes
      newFile = fName & " " & Format$(Date, "mm-dd-yyyy")
      ' Change directory to suit your PC, including USER NAME 
      ChDir "W:\Planning\Direct Orders\2011"
      ActiveWorkbook.SaveAs Filename:=newFile
      '
      End Sub

      Thanks in advance for you help

      Alex

      Comment


      • #4
        Re: VBA - Create multiple excel files according to category from master excel file

        You never specified you wanted to include all the columns - always helps if you describe the issues accurately

        It would also help if you uploaded an anonymous/cut-down version of your workbook.

        I'll have a look, but in the meantime it would be appreciated if you could edit your post to include code tags around the code listing as is required by the rules. You can add code tags by editing your post and typing [code] before the code and [/code] after ...

        Comment


        • #5
          Re: VBA - Create multiple excel files according to category from master excel file

          Revised procedure dealing with columns and headers - please read first and note any comments...

          Code:
          Sub SplitSheet()
             
             Dim lngRow As Long
             Dim lngOtherRow As Long
             Dim lngCol As Long
             
             Dim strTemp As String
             Dim wb As Excel.Workbook
             Dim wbX As Excel.Workbook
             Dim ws As Excel.Worksheet
             
             '// Set to whichever is the source worksheet
             Set ws = ThisWorkbook.ActiveSheet
             
             '// Loop through used range in Column A
             '// Did start at 1, but that's headers, so start at 2 now
             
             '// NOTE: UsedRange can be very inaccurate as formatting in empty cells
             '// will affect it. It's included here as it's quick and easy.
             '// Either look for another, more accurate method or physically delete
             '// any 'empty' rows after the last data row in the source sheet before running this
             For lngRow = 2 To ws.UsedRange.Rows.Count
                
                '// Loop through all open workbooks
                For Each wbX In Application.Workbooks
                   
                   '// If the First sheet is named same as Product/Date pair
                   If wbX.Sheets(1).Name = ws.Cells(lngRow, 1) & Format$(Date, " dd-mm-yy") Then
                      '// Use this workbook
                      Set wb = wbX
                      '// No more checking to do - Exit
                      Exit For
                   End If
                Next
                
                '// If wb is still nothing after getting to here then
                '// the workbook for this product/date does not exist.
                If wb Is Nothing Then
                   '// Add it
                   Set wb = Application.Workbooks.Add
                           
                   '// Add heading row
                   For lngCol = 1 To ws.UsedRange.Columns.Count
                      wb.Sheets(1).Cells(1, lngCol).Value = ws.Cells(1, lngCol).Value
                   Next
                End If
                
                '// See how many rows used
                lngOtherRow = wb.Sheets(1).UsedRange.Rows.Count
                
                '// If the calculated max row has data, then use next row
                '// If the workbook is empty, Usedrange still returns 1, so an adjustment
                '// would have to be made whichever way it's done.
                If wb.Sheets(1).Cells(lngOtherRow, 1).Value <> "" Then
                   lngOtherRow = lngOtherRow + 1
                End If
                
                '// Copy value from source sheet to new wb
                For lngCol = 1 To ws.UsedRange.Columns.Count
                   wb.Sheets(1).Cells(lngOtherRow, lngCol).Value = ws.Cells(lngRow, lngCol).Value
                Next
                      
                If wb.Sheets(1).Name = "Sheet1" Then
                   '// Name sheet1
                   '// If this seems strange it's because a WorkBook cannot be
                   '// Named until it's saved. So Sheet1.Name is used as the
                   '// marker
                   '// This block was up when the sheet was added, but only
                   '// adding header up there now so don't know the name of
                   '// the product to assign
                '// Make up the Product/Date string
                   strTemp = ws.Cells(lngRow, 1) & Format$(Date, " dd-mm-yy")
                   wb.Sheets(1).Name = strTemp
                End If
                
                '// Delete reference to other workbook
                '// (Does not affect the workbook itsself.
                Set wb = Nothing
             
             '// Go around and do it all again
             Next
          End Sub

          I'll have a look at the other naming requirement in a bit, unless anyone else comes in with a solution first.

          Comment


          • #6
            Re: VBA - Create multiple excel files according to category from master excel file

            Once again, thanks for your quick response.

            You are right, should have mentioned that first time round. Will try to be more accurate next time. I tried the lastest code and titles and row date are copied fine now.

            I uploaded a sample of the file "sample.xls".

            Code tagged .... excuse me did not mean to break the rules :-)

            Will await for response regards the naming issue.

            Thanks

            Alex

            Comment


            • #7
              Re: VBA - Create multiple excel files according to category from master excel file

              Final version...
              Code:
              Sub SplitSheet()
                 
                 Dim lngRow As Long
                 Dim lngOtherRow As Long
                 Dim lngCol As Long
                 
                 Dim strTemp As String
                 Dim wb As Excel.Workbook
                 Dim wbX As Excel.Workbook
                 Dim ws As Excel.Worksheet
                 
                 '// Set to whichever is the source worksheet
                 Set ws = ThisWorkbook.ActiveSheet
                 
                 '// Loop through used range in Column A
                 '// Did start at 1, but that's headers, so start at 2 now
                 
                 '// NOTE: UsedRange can be very inaccurate as formatting in empty cells
                 '// will affect it. It's included here as it's quick and easy.
                 '// Either look for another, more accurate method or physically delete
                 '// any 'empty' rows after the last data row in the source sheet before running this
                 For lngRow = 2 To ws.UsedRange.Rows.Count
                    
                    '// Loop through all open workbooks
                    For Each wbX In Application.Workbooks
                       
                       '// If the First sheet is named same as Product/Date pair
                       If wbX.Sheets(1).Name = ws.Cells(lngRow, 1) & Format$(Date, " dd-mm-yy") Then
                          '// Use this workbook
                          Set wb = wbX
                          '// No more checking to do - Exit
                          Exit For
                       End If
                    Next
                    
                    '// If wb is still nothing after getting to here then
                    '// the workbook for this product/date does not exist.
                    If wb Is Nothing Then
                       '// Add it
                       Set wb = Application.Workbooks.Add
                               
                       '// Add heading row
                       For lngCol = 1 To ws.UsedRange.Columns.Count
                          wb.Sheets(1).Cells(1, lngCol).Value = ws.Cells(1, lngCol).Value
                       Next
                    End If
                    
                    '// See how many rows used
                    lngOtherRow = wb.Sheets(1).UsedRange.Rows.Count
                    
                    '// If the calculated max row has data, then use next row
                    '// If the workbook is empty, Usedrange still returns 1, so an adjustment
                    '// would have to be made whichever way it's done.
                    If wb.Sheets(1).Cells(lngOtherRow, 1).Value <> "" Then
                       lngOtherRow = lngOtherRow + 1
                    End If
                    
                    '// Copy value from source sheet to new wb
                    For lngCol = 1 To ws.UsedRange.Columns.Count
                       wb.Sheets(1).Cells(lngOtherRow, lngCol).Value = ws.Cells(lngRow, lngCol).Value
                    Next
                          
                    If wb.Sheets(1).Name = "Sheet1" Then
                       '// Name sheet1
                       '// If this seems strange it's because a WorkBook cannot be
                       '// Named until it's saved. So Sheet1.Name is used as the
                       '// marker
                       '// This block was up when the sheet was added, but only
                       '// adding header up there now so don't know the name of
                       '// the product to assign
                    '// Make up the Product/Date string
                       strTemp = ws.Cells(lngRow, 1) & Format$(Date, " dd-mm-yy")
                       wb.Sheets(1).Name = strTemp
                       
                       
                       '// OK, saving... as the procedure does not know which
                       '// workbooks it created, sheet 2 will be named as something
                       '// (anything) that is bound to be unique
                       '// Later, will loop through all the workbooks saving them
                       '// with the name of Sheet 1 name if sheet 2 name is as below
                       wb.Sheets(2).Name = "OzGridSamplePosting"
                    End If
                    
                    '// Delete reference to other workbook
                    '// (Does not affect the workbook itsself.
                    Set wb = Nothing
                 
                 '// Go around and do it all again
                 Next
                 
                 '// Save created workbooks
                 For Each wbX In Application.Workbooks
                       
                    If wbX.Sheets(2).Name = "OzGridSamplePosting" Then
                       
                       Application.DisplayAlerts = False
                       wbX.Sheets(2).Delete
                       Application.DisplayAlerts = True
                       '// Include the directory to save to...
                       wbX.SaveAs Filename:="D:\SAVE\" & wbX.Sheets(1).Name '// Add any other options sub as fileformat
                       wbX.Close savechanges:=xlDoNotSaveChanges
                       
                    End If
                 Next
              End Sub

              Again, it's a little bit of a kludge. What it does now is name the second sheet of any workbook it creates as 'OzGridSomethingorother'. This is purely as marker. After all the lines have been transferred it then loops through all the open workbooks and if sheet 2 is named as whatever, sheet2 is deleted and the workbook saved using the name of sheet 1. Don't forget to change/add the path you want to save to...

              Thank you for editing your other post.

              Comment


              • #8
                Re: VBA - Create multiple excel files according to category from master excel file

                Tried the code but it is giving an error on this line

                Code:
                 If wbX.Sheets(2).Name = "OzGridSamplePosting" Then
                The error is: "Runtime error '9'. Script out of Range"

                ...any idea what I am doing wrong?

                Edit: The second sheet is being named correctly to "OzGridSamplePosting" as per your remarks, but still the error

                Comment


                • #9
                  Re: VBA - Create multiple excel files according to category from master excel file

                  Works for me - can you try the code in your sample workbook? If it still errs then upload the sample with the code in it...

                  Comment


                  • #10
                    Re: VBA - Create multiple excel files according to category from master excel file

                    Uploaded sample2.xls
                    Attached Files

                    Comment


                    • #11
                      Re: VBA - Create multiple excel files according to category from master excel file

                      One of those sillies - it didn't check there's more than one worksheet, so when it found your original workbook (which only has 1 worksheet) it threw a wobbly. A perfect example of why error handling should be included as standard

                      Change the last loop where it saves to this...
                      Code:
                         For Each wbX In Application.Workbooks
                            '// This line was added to check the number of sheets
                            If wbX.Sheets.Count > 1 Then
                               If wbX.Sheets(2).Name = "OzGridSamplePosting" Then   '<---- THIS LINE IS GIVING THE ERROR
                      
                                  Application.DisplayAlerts = False
                                  wbX.Sheets(2).Delete
                                  Application.DisplayAlerts = True
                                  '// Include the directory to save to...
                                  wbX.SaveAs Filename:="W:\Planning\Direct Orders\2011\" & wbX.Sheets(1).Name   '// Add any other options sub as fileformat
                                  wbX.Close savechanges:=xlDoNotSaveChanges
                      
                               End If
                            '// The corresponding End If for the new check...
                            End If
                         Next
                      *EDIT* - urther clarification - if your Excel settings specify only one worksheet in a new workbook then it will fail as well. Easy enough to workaround so just a note for anyone reading
                      Last edited by cytop; April 21st, 2011, 23:43.

                      Comment


                      • #12
                        Re: VBA - Create multiple excel files according to category from master excel file

                        Thanks, now it works perfectly :-) You are a genius.

                        By any chance would it be easy for you to tell me how I can also keep the original formats of the data in the copied files? Like gridlines, bold font, etc? Or am I asking for too much now?

                        Comment


                        • #13
                          Re: VBA - Create multiple excel files according to category from master excel file

                          Totally untested and typing on the fly - you could try changing the lines that copy the details from
                          Code:
                                '// Copy value from source sheet to new wb
                                For lngCol = 1 To ws.UsedRange.Columns.Count
                                   wb.Sheets(1).Cells(lngOtherRow, lngCol).Value = ws.Cells(lngRow, lngCol).Value
                                Next
                          to
                          Code:
                                '// Copy value from source sheet to new wb
                                For lngCol = 1 To ws.UsedRange.Columns.Count
                          
                                   ws.cells(lngRow, lngCol).copy
                                   wb.sheets(1).cells(lngotherrow, lngcol).pastespecial (xlPasteAll)
                                   '// Or something like that...
                                Next
                          However, that is getting to be very inefficient - and will only copy cell attributes, not column widths or sheet attributes like gridlines.

                          To be honest, I don't have a definite answer as to the best way of doing what you want.

                          Comment


                          • #14
                            Re: VBA - Create multiple excel files according to category from master excel file

                            No worries what you did is suffecient for me. The formats were just the 'cherry on the cake' so to speak. Thanks for your great support cytop.

                            Comment


                            • #15


                              Re: VBA - Create multiple excel files according to category from master excel file

                              The macro works when I save it in the workbook, but not when I save it in the personal file so that I have it available for all workbooks. Am I missing something?

                              Comment

                              Working...
                              X