Create Sheets and move data based on unique items in a specific column, using Excel VBA

I am familiar with programming, but not VBA or the excel object model. I am finding it intensely frustrating to deal with.

What I have is a single sheet of data with column headings. There are a variable number of headings depending on the type of data, so I need to find a specific column (in all sheets) that is not always in the same place (so I cannot hardcode it).

I want to create a sheet for each last name, preferably title it with that name, and then copy from the original sheet to each specific sheet, all ROWs with the name

What I have so far:

   Cells.find(What:="Last_Name", After:=ActiveCell, LookIn:=xlFormulas, _
       LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
       MatchCase:=False, SearchFormat:=False).Activate

To find the column with the names. I can then sort the column (which isn't totally necessary, but it helps when doing the copying part manually.)

    ActiveCell.Sort key1:=ActiveCell, Order1:=xlAscending, Header:=xlYes

but after that I am struggling to find a way to get the unique items into a list or array or something.

I know how to create a sheet with

Set WS = Sheets.Add
WS.name = "string name goes here"

So the main part is finding a way to iterate over the unique names, making sheets and copying appropriate rows into the sheets with the same name in the sheet as in the row.

Any tips to learn VBA o开发者_如何学Gor any other way (.Net somehow?) of interfacing with Excel would be very appreciated.

This should get you close

Sub MakeLastNameSheets()

    Dim rLNColumn As Range
    Dim rCell As Range
    Dim sh As Worksheet
    Dim shDest As Worksheet
    Dim rNext As Range

    Const sLNHEADER As String = "Last_Name"

    Set sh = ThisWorkbook.Sheets("Sheet1")
    Set rLNColumn = sh.UsedRange.Find(sLNHEADER, , xlValues, xlWhole)

    'Make sure you found something
    If Not rLNColumn Is Nothing Then
        'Go through each cell in the column
        For Each rCell In Intersect(rLNColumn.EntireColumn, sh.UsedRange).Cells
            'skip the header and empty cells
            If Not IsEmpty(rCell.Value) And rCell.Address <> rLNColumn.Address Then
                'see if a sheet already exists
                On Error Resume Next
                    Set shDest = sh.Parent.Sheets(rCell.Value)
                On Error GoTo 0

                'if it doesn't exist, make it
                If shDest Is Nothing Then
                    Set shDest = sh.Parent.Worksheets.Add
                    shDest.Name = rCell.Value
                End If

                'Find the next available row
                Set rNext = shDest.Cells(shDest.Rows.Count, 1).End(xlUp).Offset(1, 0)

                'Copy and paste
                Intersect(rCell.EntireRow, sh.UsedRange).Copy rNext

                'reset the destination sheet
                Set shDest = Nothing
            End If
        Next rCell
    End If

End Sub

You'll end with one sheet for every last name in your list. If you have 1,000 unique last names, you'll probably crash excel - sheets are limited to available memory. It doesn't copy the header row, but that's easy enough. And it doesn't check for illegal sheet name characters, so if you have any funky last names, you might want to clean out the non-alpha.