Home |
Search |
Today's Posts |
#6
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
You didn't share the rules for copying the rows. This copies all the rows
between "Agent Name:"'s. Option Explicit Sub testme() Dim FoundCell As Range Dim wks As Worksheet Dim BotRow As Long Dim TopRow As Long Dim NewWks As Worksheet Dim tName As String Set wks = Worksheets("sheet1") With wks BotRow = .Cells.SpecialCells(xlCellTypeLastCell).Row Set FoundCell = .Range("C1") Do With .Range("C:C") Set FoundCell = .Cells.Find(What:="Agent Name:", _ After:=FoundCell, _ LookIn:=xlValues, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False) End With If FoundCell Is Nothing Then MsgBox "nothing found!" Exit Do End If If FoundCell.Row BotRow Then Exit Do 'we've started over Else TopRow = FoundCell.Row tName = FoundCell.Offset(0, 1).Value 'get rid of any existing sheet with that name??? Application.DisplayAlerts = False On Error Resume Next Worksheets(tName).Delete On Error GoTo 0 Application.DisplayAlerts = True 'try to create a new sheet Set NewWks = Worksheets.Add On Error Resume Next NewWks.Name = tName If Err.Number < 0 Then MsgBox "Rename " & wks.Name & " Manually!" Err.Clear End If On Error GoTo 0 'copy the data .Range(.Rows(TopRow), .Rows(BotRow)).Copy _ Destination:=NewWks.Range("a1") 'get ready for the next time BotRow = TopRow - 1 End If Loop End With End Sub Or maybe you have a date on each line and want to keep the dates that are greater than a certain date. Option Explicit Sub testme() Dim FoundCell As Range Dim wks As Worksheet Dim BotRow As Long Dim TopRow As Long Dim NewWks As Worksheet Dim iRow As Long Dim DestCell As Range Dim myDate As Date Dim tName As String myDate = DateSerial(2007, 4, 28) Set wks = Worksheets("sheet1") With wks BotRow = .Cells.SpecialCells(xlCellTypeLastCell).Row Set FoundCell = .Range("C1") Do With .Range("C:C") Set FoundCell = .Cells.Find(What:="Agent Name:", _ After:=FoundCell, _ LookIn:=xlValues, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False) End With If FoundCell Is Nothing Then MsgBox "nothing found!" Exit Do End If If FoundCell.Row BotRow Then Exit Do 'we've started over Else TopRow = FoundCell.Row tName = FoundCell.Offset(0, 1).Value 'get rid of any existing sheet with that name??? Application.DisplayAlerts = False On Error Resume Next Worksheets(tName).Delete On Error GoTo 0 Application.DisplayAlerts = True 'try to create a new sheet Set NewWks = Worksheets.Add On Error Resume Next NewWks.Name = tName If Err.Number < 0 Then MsgBox "Rename " & wks.Name & " Manually!" Err.Clear End If On Error GoTo 0 'copy the data version 2 Set DestCell = NewWks.Range("a1") For iRow = TopRow To BotRow If .Cells(iRow, "A").Value2 CLng(myDate) Then .Rows(iRow).Copy _ Destination:=DestCell Set DestCell = DestCell.Offset(1, 0) End If Next iRow 'get ready for the next time BotRow = TopRow - 1 End If Loop End With End Sub Maybe it'll help--or not. Mahnian wrote: Wonderful, perfect.. This was just what I was looking for. So, now that this has been provided to me, I am finding I am unable to alter the code to do what else I need it too. What I am ultimately looking to happen is this: It scans down the column €śC€ť looking for €śAgent Name:€ť then grabbing the name one column to the right and making a new sheet from that name. There will be approximately 15 names. Additionally, I need the sheet to grab each line between two names and copy that information to the new sheet. The hook that will tell us that the line needs to be copied is in column A and will contain a date (The date is not static, but will always be in this format mm/dd/yyyy) If anyone can further help me, I would be most appreciative. "Dave Peterson" wrote: <<snipped -- Dave Peterson |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Loops | Excel Programming | |||
Loops | Excel Programming | |||
Vlookup macro that returns data from worksheet, then Loops | Excel Programming | |||
Vlookup macro that returns data from worksheet, then Loops | Excel Programming | |||
for each loops | Excel Programming |