Loading
Ozgrid Excel Help & Best Practices Forums

Excel Video Tutorials / Excel Dashboards Reports



Page 1 of 2 1 2 LastLast
Results 1 to 10 of 19

Thread: Create multiple excel files according to category from master excel file

  1. #1
    Join Date
    20th April 2011
    Posts
    9

    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

    Excel Video Tutorials / Excel Dashboards Reports


  2. #2
    Join Date
    1st September 2010
    Posts
    7,921

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

    Try this...
    VB:
     
    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

    Excel Video Tutorials / Excel Dashboards Reports


  3. #3
    Join Date
    20th April 2011
    Posts
    9

    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.

    VB:
    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

    Excel Video Tutorials / Excel Dashboards Reports


  4. #4
    Join Date
    1st September 2010
    Posts
    7,921

    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 ...

    Excel Video Tutorials / Excel Dashboards Reports


  5. #5
    Join Date
    1st September 2010
    Posts
    7,921

    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...

    VB:
     
    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.

    Excel Video Tutorials / Excel Dashboards Reports


  6. #6
    Join Date
    20th April 2011
    Posts
    9

    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

    Excel Video Tutorials / Excel Dashboards Reports


  7. #7
    Join Date
    1st September 2010
    Posts
    7,921

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

    Final version...
    VB:
     
    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.

    Excel Video Tutorials / Excel Dashboards Reports


  8. #8
    Join Date
    20th April 2011
    Posts
    9

    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

    VB:
    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

    Excel Video Tutorials / Excel Dashboards Reports


  9. #9
    Join Date
    1st September 2010
    Posts
    7,921

    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...

    Excel Video Tutorials / Excel Dashboards Reports


  10. #10
    Join Date
    20th April 2011
    Posts
    9

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

    Uploaded sample2.xls
    Attached Files. REMINDER! OzGrid accepts no responsibility for ANY adverse effects as a result from downloading attached files. ALWAYS run an up-to-date virus scan and disable macros.

    Excel Video Tutorials / Excel Dashboards Reports


Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Possible Answers

  1. Replies: 1
    Last Post: April 11th, 2011, 06:54
  2. open Multiple files in one excel file
    By arun in forum EXCEL HELP
    Replies: 1
    Last Post: September 27th, 2004, 14:46

Bookmarks

Posting Permissions

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