Solved Excel Macro to create new worksheet

Microsoft Excel 2003 (full product)
December 2, 2009 at 11:25:34
Specs: Windows XP
Can somebody please help? I have limited VB knowledge and I am stuck trying to create a macro that reads a column of data starting column A (months) and creates new worksheets for each distinct month in chronological order. Everything would start from the first sheet of data and then need to be transposed to new worksheets under the respective months. There are 16 total columns of data for each row.

See More: Excel Macro to create new worksheet

Report •


✔ Best Answer
December 2, 2009 at 16:04:53
Assuming the #### are caused by the column widths being too small, the additional lines of code included below will copy the column widths and the original headers from the first sheet as soon as the new sheets are created.

I also added Application.ScreenUpdating = False so that you won't see the flickering while the code is running. You can comment that out with a single quote if you want to see the code do it's thing while it's running.

A brief rundown of what the code is doing:

1 - It creates a temporary copy of the first sheet and names it SortTemp
2 - It sorts the data in SortTemp by date. Step 3 explains why I need to sort the dates.
3 - It compares the month and year of the dates in each cell to the cell above it. Each time it finds a new month, it creates a sheet for that month by adding a new sheet and "building" a name for the sheet by extracting the month name and year of the current cell using:

MonthName(Month(current cell)) & " " & Year(current cell)

e.g. 9/1/2009
Month("9/1/2009") = 9
MonthName(Month("9/1/2009")) = MonthName(9) = September
Year("9/1/2009") = 2009

therefore

MonthName(Month("9/1/2009")) & " " Year("9/1/2009")= September 2009

4 - After a new sheet is created, it copies the column widths and header row from Row 1.

5 - After all of the sheets are creating, it loops through each cell and copies the EntireRow to the correct sheet by first extracting the sheet name from the date in the same way it created the sheet name earlier.

6 - When it's all done, it deletes the SortTemp sheet.

Hope that helps!


Sub CreateMonthlySheets()
Dim lastRow, mMonth, tstDate1, tstDate2, shtName, nxtRow

On Error Resume Next
'Turn off ScreenUpdating
Application.ScreenUpdating = False
'Make a copy of the data sheet and sort by date
  Sheets("Sheet1").Copy After:=Sheets(1)
  Sheets(2).Name = "SortTemp"
   With Sheets("SortTemp")
      lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
       Rows("2:" & lastRow).Sort Key1:=Range("A2"), Order1:=xlAscending
       
'Using SortTemp Sheet, create monthly sheets by
'testing Month and Year values in Column A

'Loop through dates
         For Each mMonth In .Range("A2:A" & lastRow)
          tstDate1 = Month(mMonth) & Year(mMonth)
          tstDate2 = Month(mMonth.Offset(-1, 0)) & Year(mMonth.Offset(-1, 0))
          
'If Month and Year are different than cell above, create new sheet
           If tstDate1 <> tstDate2 Then
            ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
            
            
'Name the sheet based on the Month and Year
            ActiveSheet.Name = MonthName(Month(mMonth)) & " " & Year(mMonth)
'Copy Column Widths and Header Row
            .Rows(1).Copy
            ActiveSheet.Rows(1).PasteSpecial Paste:=8 'ColumnWidth
            ActiveSheet.Rows(1).PasteSpecial          'Data and Formats
           End If
         Next
  On Error GoTo 0
  
'Loop through dates, copying row to the correct sheet
     For Each mMonth In .Range("A2:A" & lastRow)
'Create sheetname variable
      shtName = MonthName(Month(mMonth)) & " " & Year(mMonth)
'Determine next empty row in sheet
      nxtRow = Sheets(shtName).Cells(Rows.Count, 1).End(xlUp).Row + 1
'Copy Data
      .Range(mMonth.Address).EntireRow.Copy Destination:=Sheets(shtName).Cells(nxtRow, 1)
     Next
   End With
'Delete SortTemp sheet
  Application.DisplayAlerts = False
    Sheets("SortTemp").Delete
  Application.DisplayAlerts = True
'Turn on ScreenUpdating
  Application.ScreenUpdating = True
End Sub



#1
December 2, 2009 at 11:55:55
Are there multiple rows for each month?

If so, is each row designated by the month name/number?

Is the data sheet already sorted by month?

These are the types of questions that will help us create the code you need.

A brief description of the data sheet's layout would be helpful.


Report •

#2
December 2, 2009 at 12:15:28
Here is some very basic code that assumes one row for each month...

A1 = January    Data1  Data2  Data16
A2 = February   Data1  Data2  Data16
A3 = March      Data1  Data2  Data16
etc.

The code will create a sheet for each month, name it for that month based on the value in the cell and then copy the entire row to Row 1 of the new sheet.

Maybe it will get you started.

Sub AddMonthlySheets()
Dim mMonth As Range
 For Each mMonth In Sheets(1).Range("A1:A12")
    ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
     ActiveSheet.Name = mMonth
     Sheets(1).Range(mMonth.Address).EntireRow.Copy Destination:=ActiveSheet.Range("A1")
 Next
End Sub


Report •

#3
December 2, 2009 at 12:16:41
Yes there are multiple rows for each month. I have already eliminated any duplicate entries. There are another 13 columns of data and 150 rows of unique entries. I basically need to have a the macro go down the column A (has a header) and grab all the individual month's entries and move them to a new sheet called ie: "Oct 09" or October 09 and so on. I hope I have been a little more clear, thank you in advance with any help or direction you can provide.

Invoice Date / # of Days Outstanding / ID#
8/1/2009 44 020001
8/1/2009 44 020001
9/1/2009 42 20001
9/8/2009 45 10294405
9/8/2009 45 10319263
1/13/2010 40 4200005
12/15/2009 34 53100945
10/15/2009 34 53100946

Report •

Related Solutions

#4
December 2, 2009 at 13:59:58
This seemed to work on your sample data.

I hope the comments are enough to explain what I tried. If not, come on back and I'll explain further.

Sub CreateMonthlySheets()
Dim lastRow, mMonth, tstDate1, tstDate2, shtName, nxtRow

On Error Resume Next

'Make a copy of the data sheet and sort by date
  Sheets("Sheet1").Copy After:=Sheets(1)
  Sheets(2).Name = "SortTemp"
   With Sheets("SortTemp")
      lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
       Rows("2:" & lastRow).Sort Key1:=Range("A2"), Order1:=xlAscending
       
'Using SortTemp Sheet, create monthly sheets by
'testing Month and Year values in Column A

'Loop through dates
         For Each mMonth In .Range("A2:A" & lastRow)
          tstDate1 = Month(mMonth) & Year(mMonth)
          tstDate2 = Month(mMonth.Offset(-1, 0)) & Year(mMonth.Offset(-1, 0))
          
'If Month and Year are different than cell above, create new sheet
           If tstDate1 <> tstDate2 Then
            ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
            
'Name the sheet based on the Month and Year
            ActiveSheet.Name = MonthName(Month(mMonth)) & " " & Year(mMonth)
           End If
         Next
  On Error GoTo 0
  
'Loop through dates, copying row to the correct sheet
     For Each mMonth In .Range("A2:A" & lastRow)
'Create sheetname variable
      shtName = MonthName(Month(mMonth)) & " " & Year(mMonth)
'Determine next empty row in sheet
      nxtRow = Sheets(shtName).Cells(Rows.Count, 1).End(xlUp).Row + 1
'Copy Data
      .Range(mMonth.Address).EntireRow.Copy Destination:=Sheets(shtName).Cells(nxtRow, 1)
     Next
   End With
'Delete SortTemp sheet
  Application.DisplayAlerts = False
    Sheets("SortTemp").Delete
  Application.DisplayAlerts = True
End Sub


Report •

#5
December 2, 2009 at 14:21:35
Wow, I wish I could understand half the code you wrote but the results are amazing. This will save so much time every month. The only one problems I have (which at this point are minor), is there anyway to have the new months paste exact as they were on the original worksheet? I'm getting a lot of formatting errors "####" and I lost my original headers past the first sheet. Again , thank you for your help!

Report •

#6
December 2, 2009 at 15:52:38
Hi,

If you have several worksheets with the same headings and the same data in the same places on each sheet, you can group all those sheets together and apply the formating on the visible sheet and it will be applied to all the other sheets that were grouped together.

Use the Worksheet name tabs. Click on the first one you want to group together. Hold down the Shift key and click on the last one to be grouped, or use the Ctrl key + click to select individual sheets to add to the group.

Now apply formatting.
(Any data added to the visible sheet will be applied to the same cell on all the grouped sheets, so just apply formatting, although you can use it to apply the same text for headings for instance, to all grouped sheets).

To end the grouping, click on an ungrouped worksheet tab or right click a grouped worksheet tab and select Ungroup sheets.

Regards


Report •

#7
December 2, 2009 at 16:04:53
✔ Best Answer
Assuming the #### are caused by the column widths being too small, the additional lines of code included below will copy the column widths and the original headers from the first sheet as soon as the new sheets are created.

I also added Application.ScreenUpdating = False so that you won't see the flickering while the code is running. You can comment that out with a single quote if you want to see the code do it's thing while it's running.

A brief rundown of what the code is doing:

1 - It creates a temporary copy of the first sheet and names it SortTemp
2 - It sorts the data in SortTemp by date. Step 3 explains why I need to sort the dates.
3 - It compares the month and year of the dates in each cell to the cell above it. Each time it finds a new month, it creates a sheet for that month by adding a new sheet and "building" a name for the sheet by extracting the month name and year of the current cell using:

MonthName(Month(current cell)) & " " & Year(current cell)

e.g. 9/1/2009
Month("9/1/2009") = 9
MonthName(Month("9/1/2009")) = MonthName(9) = September
Year("9/1/2009") = 2009

therefore

MonthName(Month("9/1/2009")) & " " Year("9/1/2009")= September 2009

4 - After a new sheet is created, it copies the column widths and header row from Row 1.

5 - After all of the sheets are creating, it loops through each cell and copies the EntireRow to the correct sheet by first extracting the sheet name from the date in the same way it created the sheet name earlier.

6 - When it's all done, it deletes the SortTemp sheet.

Hope that helps!


Sub CreateMonthlySheets()
Dim lastRow, mMonth, tstDate1, tstDate2, shtName, nxtRow

On Error Resume Next
'Turn off ScreenUpdating
Application.ScreenUpdating = False
'Make a copy of the data sheet and sort by date
  Sheets("Sheet1").Copy After:=Sheets(1)
  Sheets(2).Name = "SortTemp"
   With Sheets("SortTemp")
      lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
       Rows("2:" & lastRow).Sort Key1:=Range("A2"), Order1:=xlAscending
       
'Using SortTemp Sheet, create monthly sheets by
'testing Month and Year values in Column A

'Loop through dates
         For Each mMonth In .Range("A2:A" & lastRow)
          tstDate1 = Month(mMonth) & Year(mMonth)
          tstDate2 = Month(mMonth.Offset(-1, 0)) & Year(mMonth.Offset(-1, 0))
          
'If Month and Year are different than cell above, create new sheet
           If tstDate1 <> tstDate2 Then
            ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
            
            
'Name the sheet based on the Month and Year
            ActiveSheet.Name = MonthName(Month(mMonth)) & " " & Year(mMonth)
'Copy Column Widths and Header Row
            .Rows(1).Copy
            ActiveSheet.Rows(1).PasteSpecial Paste:=8 'ColumnWidth
            ActiveSheet.Rows(1).PasteSpecial          'Data and Formats
           End If
         Next
  On Error GoTo 0
  
'Loop through dates, copying row to the correct sheet
     For Each mMonth In .Range("A2:A" & lastRow)
'Create sheetname variable
      shtName = MonthName(Month(mMonth)) & " " & Year(mMonth)
'Determine next empty row in sheet
      nxtRow = Sheets(shtName).Cells(Rows.Count, 1).End(xlUp).Row + 1
'Copy Data
      .Range(mMonth.Address).EntireRow.Copy Destination:=Sheets(shtName).Cells(nxtRow, 1)
     Next
   End With
'Delete SortTemp sheet
  Application.DisplayAlerts = False
    Sheets("SortTemp").Delete
  Application.DisplayAlerts = True
'Turn on ScreenUpdating
  Application.ScreenUpdating = True
End Sub


Report •

#8
December 3, 2009 at 07:24:17
Thank you for building this macro to the exact specifics, but more importantly, explaining what each line of code is actually doing . Although redundant to most, it really helps to see such thorough explanations for each step of code. I am able to break down specific processes to certain lines and hopefully understand them for later application. Again, many thanks!

Report •

#9
December 3, 2009 at 08:37:48
re: Although redundant to most, it really helps to see such thorough explanations for each step of code.

Adding the comments serves at least 3 purposes, 2 of which you mentioned:

1 - They explain to the reader what each section of code is doing.

2 - They help the beginner (and many times, experts as well) understand the various VBA coding techniques which can then be adapted for other uses.

and - maybe more important than 1 and 2 -

3 - They help the writer remember just what the heck they were thinking when they wrote the code!

I have macros which contain hundreds of lines of code that I use once a year, sometimes less. When I pull them out of storage, they often have to be modified to fit a specific situation.

If I didn't include comments, I would have to spend time deciphering my own code before I could modify it. With liberal use of comments, I can pin-point the exact sections that I need to work on.

In other words, we are as much being selfish as helpful when we include the comments.


Report •


Ask Question