Adding anc copying to a new worksheet based on data 1

[mgerard802]

I want to to add worksheets and copy certain data to the
new worksheet based on values in a column. For example:
Name Amount
Mike 1
John 1
Sally 2
John 2
John 2
Mike 5

So I would want to add a worksheet for each name, and copy
the appropriate data for that name.
A new worksheet would be added, with Mike 1, Mike 5 and so
on.
What would be the easiest way to accomplish this.
Thanks

 

[Nikita6003]

Hiya,

I've set up some code which'll check to see if a sheet already exists for a person
If not, add a sheet
report the values per person on the appropriate sheet

Sub CreateReportSheets()
    Dim l_wksReportSheet As Worksheet
    Dim l_wksNameTable As Worksheet
    Dim l_vArray As Variant
    Dim l_iLoop As Integer
    Dim l_lRowToStart As Long
    
    Set l_wksNameTable = ThisWorkbook.Sheets("NameTable")
    'Set array to range - with thanks to xlbo
    l_vArray = l_wksNameTable.Range("rngNameTable")
    
    'Loop thru array & report per name
    For l_iLoop = 1 To UBound(l_vArray)
   
        If DoesSheetExist(ThisWorkbook, Trim(l_vArray(l_iLoop, 1))) Then
            Set l_wksReportSheet = ThisWorkbook.Sheets(l_vArray(l_iLoop, 1))
        Else
            Set l_wksReportSheet = ThisWorkbook.Sheets.Add
            l_wksReportSheet.Name = Trim(l_vArray(l_iLoop, 1))
            l_wksReportSheet.Cells(1, 1) = "Name"
            l_wksReportSheet.Cells(1, 2) = "Amount"
        End If
        l_lRowToStart = l_wksReportSheet.UsedRange.Rows.Count + 1
        l_wksReportSheet.Cells(l_lRowToStart, 1) = Trim(l_vArray(l_iLoop, 1))
        l_wksReportSheet.Cells(l_lRowToStart, 2) = Trim(l_vArray(l_iLoop, 2))
    Next l_iLoop
    
    Set l_wksNameTable = Nothing
    
End Sub

Function DoesSheetExist(p_wkbWorkbook As Workbook, p_sSheetname As String) As Boolean
    
    On Error GoTo ErrorHandler
    DoesSheetExist = False
    
    'Try to activate sheet
    p_wkbWorkbook.Sheets(p_sSheetname).Activate
    
    'No error - sheet must exist. Have function DoesSheetExist return TRUE
    DoesSheetExist = True
    
    Exit Function
ErrorHandler:
    'DoesSheetExist is already set to false so do nothing
End Function

HTH!

Cheers
Nikki

 

[mgerard802]

Nikki,

Thank you very much for the code. I tried running it, and I am getting an error. I named the worksheet NameTable to get past the 1st error, now I am getting
"Method 'Range' of object '_Worksheet' failed." on the l_vArray = l_wksNameTable.Range("rngNameTable&quot line. Any thoughts?

 

[Nikita6003]

Yup.
you need to select your table (the one that's got the names + values in it) - exclude the header! - and name that range rngNameTable: to do that quickly:

select data
click in the Name Box (left hand side of Formula bar) and type the name rngNameTable

Range names are a quick and more importantly STABLE way of referring to a range - see also MANY posts
It's an alternative to saying "A2:B7"

HTH

Cheers
Nikki ;-)

 

[mgerard802]

Nikki,

Once again, thank you. One more question. When I try to run the macro with other files (personal.xls or when I have the original open and run it in another open workbook), the macro stops on the Set l_wksNameTable = ThisWorkbook.Sheets("NameTable&quot line saying the subscript is out of range. I thought by using ThisWorkbook, it could be used in other workbooks?
Thanks again.

 

[Nikita6003]

Nope - thisworkbook means just that: in THIS WORKBOOK - i.e. the one where you've got the macto - it'll try to find the sheet.

You could, if the workbook you need is the active one, substitute ActiveWorkbook; it'd be even better to add:

Dim l_wkbWorkbook As WorkBook

Set l_wkbWorkbook = Application.Open ("C:\Temp\ThisIsAnExample.xls")

Set l_wksNametable = l_wkbWorkbook.Sheets("Nametable")


...

Set l_wkbWorkbook = Nothing

This way, you'll always refer to the correct workbook ;-)


Cheers
Nikki
& thanks for the star