Selecting Number of Cells Dynamically in a macro

[lamorak]

This might be a duplicate question, but I dont know the right verbage to search for what I want.



I have a table in Excel 2010, Windows7, that looks like:[TABLE="width: 500"]
<tbody>[TR]
[TD]PM3[/TD]
[TD]Time[/TD]
[TD]Meters[/TD]
[/TR]
[TR]
[TD]Mike[/TD]
[TD]0[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1<time></time>[/TD]
[TD]10<integer></integer>[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]2<time></time>[/TD]
[TD]4<integer></integer>[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]3<time></time>[/TD]
[TD]3<integer></integer>[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]4<time></time>[/TD]
[TD]2<integer></integer>[/TD]
[/TR]
[TR]
[TD]Tim[/TD]
[TD]0[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1<time></time>[/TD]
[TD]2<integer></integer>[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]3<time></time>[/TD]
[TD]5<integer></integer>[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]6<time></time>[/TD]
[TD]7<integer></integer>[/TD]
[/TR]
[TR]
[TD]Jon[/TD]
[TD]0[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1<time></time>[/TD]
[TD]2<integer></integer>[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]3<time></time>[/TD]
[TD]1<integer></integer>[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1<time></time>[/TD]
[TD]1<integer></integer>[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1<time></time>[/TD]
[TD]1<integer></integer>[/TD]
[/TR]
</tbody>[/TABLE]


except there will be about a thousand rows between names in column A.


What I'd like to be able to do is create a macro that takes all the cells from one person's name to the next, and places that data into its own worksheet.


The part that is tripping me up is that the number of rows for each person varies, so I cannot just grab 1000 rows at a time.




Thanks!

 

[BIGTONE559]

which column is the names data in and what columns are the data in that you want to move. when you move it do you want to rename the sheet? is the name in the column multiple times? as you can see there are quite a few questions. would help more if we had an actual sample file

 

[lamorak]

The name data is in column A called PM3. I will want to extract all the columns A-E for each person. I would like to rename the sheet to the name in column A. Names will not appear multiple times, however there could be a "Mike D" and a "Mike R". I will edit the original post to include a sample file.

 

[lamorak]

I couldn't figure out how to add a file to my post, so here is a truncated version of my table, I will add column Letters and Row numbers.
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]PM3[/TD]
[TD]Time[/TD]
[TD]Meters[/TD]
[TD]Current_Pace[/TD]
[TD]Stroke_Rate[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Mike D[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD][/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]33[/TD]
[TD]117[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD][/TD]
[TD]2[/TD]
[TD]3[/TD]
[TD]32[/TD]
[TD]117[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD][/TD]
[TD]3[/TD]
[TD]8[/TD]
[TD]32[/TD]
[TD]117[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]Tim[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD][/TD]
[TD]1[/TD]
[TD]4[/TD]
[TD]22[/TD]
[TD]113[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD][/TD]
[TD]2[/TD]
[TD]7[/TD]
[TD]23[/TD]
[TD]113[/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD][/TD]
[TD]3[/TD]
[TD]13[/TD]
[TD]22[/TD]
[TD]112[/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD][/TD]
[TD]4[/TD]
[TD]15[/TD]
[TD]22[/TD]
[TD]113[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]Jon[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD][/TD]
[TD]2[/TD]
[TD]5[/TD]
[TD]33[/TD]
[TD]114[/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD][/TD]
[TD]3[/TD]
[TD]10[/TD]
[TD]33[/TD]
[TD]114[/TD]
[/TR]
</tbody>[/TABLE]

As i said previously there will be around 1000 rows between each name in column A. Also, there will generally be around 20 names worth of data.

 

[Rick Rothstein]

Does this macro do what you want...

Sub MoveNamesToTheirOwnSheets()
  Dim LastRow As Long, B As Range, Blanks As Range, Data As Worksheet, NewSheet As Worksheet
  Set Data = Sheets("Sheet1")
  LastRow = Data.Cells(Rows.Count, "B").End(xlUp).Row
  Set Blanks = Data.Range("A2:A" & LastRow).SpecialCells(xlBlanks)
  Application.ScreenUpdating = False
  For Each B In Blanks.Areas
    Set NewSheet = Sheets.Add(After:=Sheets(Sheets.Count))
    NewSheet.Name = B(1).Offset(-1).Value
    Data.Rows(1).Copy NewSheet.Range("A1")
    B(1).Offset(-1).Resize(B.Count + 1).EntireRow.Copy NewSheet.Range("A2")
  Next
  Data.Activate
  Application.ScreenUpdating = True
End Sub

NOTE: Change the red highlighted sheet name to the actual sheet name where your data is located.

 

[lamorak]

Wow, it sure does. Thank you very much for your help!