Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Westi on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Loop Through a column

Status
Not open for further replies.

robcarr

Programmer
May 15, 2002
633
GB
Dear All,

I have a spreadsheet with approx 400 rows of data, I need to copy all rows with Dan smith in column E to a new sheet in the same workbook and name that sheet Dan Smith, the problem is I don't know what names will appear in the report and how many times they will appear, i need this to loop through all names in the column until it finds a blank cell, so what i should end up with is sheet 1 having all the data, and then a load of other sheets with each agents name on and all the records for them within the sheet. Has anyone done anything like this?

Thanks in advance for any help on this.



Thanks Rob.[yoda]
 
I think the approach I'd take would be to switch on teh macro recorder, use the advanced filter to copy dan smith to his own sheet.

The use the resulting code as one iteration within a loop or something similar.

 
'-------------------------------------------------
'- UNTESTED !!!
Sub UNtested()
Dim DataSheet As Worksheet
Dim FromRow As Long
Dim MyName As String
Dim SheetDone As Boolean
Dim ToSheet As Worksheet
Dim ToRow As Long
'------------------------
Set DataSheet = ActiveSheet
FromRow = 1
While DataSheet.Cells(FromRow, 1) <> &quot;&quot;
MyName = DataSheet.Cells(FromRow, 5).Value
SheetDone = False
'-------------------------------------------
For Each ws In ThisWorkbook.Worksheets
If ws.Name = MyName Then SheetDone = True
Next
'-------------------------------------------
If SheetDone = False Then
Worksheets.Add after:=ThisWorkbook.Worksheets.Count
ActiveSheet.Name = MyName
End If
'-------------------------------------------
Set ToSheet = ThisWorkbook.Worksheets(MyName)
ToRow = ToSheet.Range(&quot;A65536&quot;).End(xlUp).Row + 1
'- NEEDS CODE HERE TO ADD DATA
'---------------------------------------------
FromRow = FromRow + 1
Wend
End Sub
'-----------------------------------------------------

You need to add code to transfer the data. Can't do everything for you <grin>.

Regards
BrianB
** Let us know if you get something that works !
================================
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top