Excel Macro to create sheets

Question

I have a Excel sheet with two columns and I need to create new sheets based on the values of the first column.ie

A        B
test1    Value21
test1    Values22
test2    Value21
test2    Value32
test3    Values32

IN this case I need to create three sheets namely test1,test2 and test3

Sheet 1 should contain test1 field and its corresponding values.Similarly sheet 2 and 3 should contain corresponding values.

Can anyone help me in writing an Excel Macro for this

Pricey Pricey · Accepted Answer · 2010-03-30T12:28:42

I would recommend using a pivot table instead, depending on what you are trying to achieve.. if you need to do the above then I would try and do the below steps, I'll leave writing the code up to you, I have put a few functions below to help.

Select all used cells in A as a range.
Loop through the range and for each cell check if a sheet already exists with a name matching the cell value.
If the sheet does not exist then you can create it and then use the R1C1 reference style to get the value from column B and paste it into the newly created sheet. Bare in mind a newly created sheet becomes the active sheet.
If the sheet exists then you can select the worksheet and do the same as in 3, making sure you paste into the next available cell below any already done.

I recommend using the macro recording to work out how to do the copy and paste etc.

Here is an example of adding and delete a work sheet:

Dim sheetname
'not tested this, something similar to get the value, obviously you will need to loop through checking this sheet name
sheetname = Range("A:A").Cells(1,1).Value

If SheetExists(sheetname, ThisWorkbook.Name) Then
    'turn off alert to user before auto deleting a sheet so the function is not interrupted
    Application.DisplayAlerts = False
    ThisWorkbook.Worksheets(sheetname).Delete
    Application.DisplayAlerts = True
End If

'Activating ThisWorkbook in case it is not
ThisWorkbook.Activate
Application.Sheets.Add

'added sheet becomes the active sheet, give the new sheet a name
ActiveSheet.Name = sheetname

Here is a sheetexists function that also makes use of the WorkbookIsOpen function shown below it. This can be used to help you see if a sheet you want to create already exists or not.

    Function SheetExists(sname, Optional wbName As Variant) As Boolean
    '   check a worksheet exists in the active workbook
    '   or in a passed in optional workbook
        Dim X As Object

        On Error Resume Next
        If IsMissing(wbName) Then
            Set X = ActiveWorkbook.Sheets(sname)
        ElseIf WorkbookIsOpen(wbName) Then
            Set X = Workbooks(wbName).Sheets(sname)
        Else
            SheetExists = False
            Exit Function
        End If

        If Err = 0 Then SheetExists = True _
        Else SheetExists = False
    End Function

    Function WorkbookIsOpen(wbName) As Boolean
    '   check to see if a workbook is actually open
        Dim X As Workbook
        On Error Resume Next
        Set X = Workbooks(wbName)
        If Err = 0 Then WorkbookIsOpen = True _
        Else WorkbookIsOpen = False
    End Function

I would recommend giving the values in range A a name that way you can iterate over them more easily so you can do this sort of thing:

For Each Cell In Range("ListOfNames")
...
Next

If you cant do that then you will need a function to check column A for a used range. like this one:

Function GetUsedRange(wbName As String, Optional wsName As Variant, Optional argFirstRow As Variant, Optional argLastCol As Variant) As Range
'this function uses the find method rather than the usedrange property because it is more reliable
'I have also added optional params for getting a more specific range
    Dim lastRow As Long
    Dim firstRow As Long
    Dim lastCol As Integer
    Dim firstCol As Integer
    Dim ws As Worksheet

    If Not IsMissing(wsName) Then
        If SheetExists(wsName, wbName) Then
            Set ws = Workbooks(wbName).Worksheets(wsName)
        Else
            Set ws = Workbooks(wbName).ActiveSheet
        End If
    Else
        Set ws = Workbooks(wbName).ActiveSheet
    End If

    If IsMissing(argFirstRow) Then
        ' Find the FIRST real row
        firstRow = ws.Cells.Find(What:="*", SearchDirection:=xlNext, SearchOrder:=xlByRows).Row
    Else
        firstRow = argFirstRow
    End If

    ' Find the FIRST real column
    firstCol = ws.Cells.Find(What:="*", SearchDirection:=xlNext, SearchOrder:=xlByColumns).Column
    ' Find the LAST real row
    lastRow = ws.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row

    If IsMissing(argLastCol) Then
        ' Find the LAST real column
        lastCol = ws.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
    Else
        lastCol = argLastCol
    End If

    'return the ACTUAL Used Range as identified by the variables above
    Set GetUsedRange = ws.Range(ws.Cells(firstRow, firstCol), ws.Cells(lastRow, lastCol))
End Function

Excel Macro to create sheets

1 Answers