Using Do Loops to copy data
 

I need a bit of code that will search through each cell in a column and look
for €œAgent Name:€� then choose cell to its right and create a new sheet with
the value of the selected cell as the name.

Below I have added what I tried, which obviously did not work. Any help on
this would be greatly appreciated. (Note, I can make the new sheet and name
it, so my test code just had a msgbox pop up with the value for testing)

=-=-=-=-=-=-=-=

Dim rngEdit As Range
Dim trow As Integer
Dim tcol As Integer
Dim tname As String

Sub LoopIt()
trow = 1
tcol = 3
Set rngEdit = ActiveSheet.Cells(trow, tcol)
Do Until rngEdit.Value = "Agent Name:"
trow = trow + 1
Loop
tcol = tcol + 1
tname = ActiveSheet.Cells(trow, tcol).Value
tcol = tcol - 1
MsgBox trow & " " & tcol
End Sub

Using Do Loops to copy data
 

On Apr 27, 12:06 pm, Mahnian
wrote:
I need a bit of code that will search through each cell in a column and look
for "Agent Name:" then choose cell to its right and create a new sheet with
the value of the selected cell as the name.

Below I have added what I tried, which obviously did not work. Any help on
this would be greatly appreciated. (Note, I can make the new sheet and name
it, so my test code just had a msgbox pop up with the value for testing)

=-=-=-=-=-=-=-=

Dim rngEdit As Range
Dim trow As Integer
Dim tcol As Integer
Dim tname As String

Sub LoopIt()
trow = 1
tcol = 3
Set rngEdit = ActiveSheet.Cells(trow, tcol)
Do Until rngEdit.Value = "Agent Name:"
trow = trow + 1
Loop
tcol = tcol + 1
tname = ActiveSheet.Cells(trow, tcol).Value
tcol = tcol - 1
MsgBox trow & " " & tcol
End Sub

It seems as if you created an infinite loop. Hopefully you know that
ctrl+Pause/Break will interrupt code execution. The problem is that
you have set up a condition with rngEdit.Value, but you have not
created a way to change rngEdit.Value (ie rngEdit.Value will always be
Cells(1, 3)). Copy and paste your Set statement inside the Do Loop
after the trow=trow+1 statement. This should fix your problem.
(Also, for kicks, look up the Offset property in Excel VBE Help).

Matt

Using Do Loops to copy data
 

Thank you for the responce. I did as you suggested, and now I get an error
that states:

Run-Time error '91':
Object variable or With block variable not set

Below I have also placed the slightly altered code. Any additional help
would be appricated.

Dim rngEdit As Range
Dim trow As Integer
Dim tcol As Integer
Dim tname As String

Sub LoopIt()
trow = 1
tcol = 3
Do Until rngEdit.Value = "Agent Name:"
trow = trow + 1
Set rngEdit = ActiveSheet.Cells(trow, tcol)
Loop
tcol = tcol + 1
tname = ActiveSheet.Cells(trow, tcol).Value
tcol = tcol - 1
MsgBox trow & " " & tcol
End Sub

"matt" wrote:

On Apr 27, 12:06 pm, Mahnian
wrote:
I need a bit of code that will search through each cell in a column and look
for "Agent Name:" then choose cell to its right and create a new sheet with
the value of the selected cell as the name.

Below I have added what I tried, which obviously did not work. Any help on
this would be greatly appreciated. (Note, I can make the new sheet and name
it, so my test code just had a msgbox pop up with the value for testing)

=-=-=-=-=-=-=-=

Dim rngEdit As Range
Dim trow As Integer
Dim tcol As Integer
Dim tname As String

Sub LoopIt()
trow = 1
tcol = 3
Set rngEdit = ActiveSheet.Cells(trow, tcol)
Do Until rngEdit.Value = "Agent Name:"
trow = trow + 1
Loop
tcol = tcol + 1
tname = ActiveSheet.Cells(trow, tcol).Value
tcol = tcol - 1
MsgBox trow & " " & tcol
End Sub

It seems as if you created an infinite loop. Hopefully you know that
ctrl+Pause/Break will interrupt code execution. The problem is that
you have set up a condition with rngEdit.Value, but you have not
created a way to change rngEdit.Value (ie rngEdit.Value will always be
Cells(1, 3)). Copy and paste your Set statement inside the Do Loop
after the trow=trow+1 statement. This should fix your problem.
(Also, for kicks, look up the Offset property in Excel VBE Help).

Matt

Using Do Loops to copy data
 

Sometimes, just using Edit|Find (in code) will make things quicker:

Option Explicit
Sub testme()

Dim FoundCell As Range
Dim wks As Worksheet
Dim tName as String

Set wks = ActiveSheet

With wks
With .Range("C:C")
Set FoundCell = .Cells.Find(What:="Agent Name:", _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

End With

If FoundCell Is Nothing Then
MsgBox "Total not found in column C!"
Exit Sub
End If

tName = foundcell.offset(0,1).value
msgbox tname

End With
End Sub

Mahnian wrote:

I need a bit of code that will search through each cell in a column and look
for €œAgent Name:€� then choose cell to its right and create a new sheet with
the value of the selected cell as the name.

Below I have added what I tried, which obviously did not work. Any help on
this would be greatly appreciated. (Note, I can make the new sheet and name
it, so my test code just had a msgbox pop up with the value for testing)

=-=-=-=-=-=-=-=

Dim rngEdit As Range
Dim trow As Integer
Dim tcol As Integer
Dim tname As String

Sub LoopIt()
trow = 1
tcol = 3
Set rngEdit = ActiveSheet.Cells(trow, tcol)
Do Until rngEdit.Value = "Agent Name:"
trow = trow + 1
Loop
tcol = tcol + 1
tname = ActiveSheet.Cells(trow, tcol).Value
tcol = tcol - 1
MsgBox trow & " " & tcol
End Sub

--

Dave Peterson

Using Do Loops to copy data
 

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:

Sometimes, just using Edit|Find (in code) will make things quicker:

Option Explicit
Sub testme()

Dim FoundCell As Range
Dim wks As Worksheet
Dim tName as String

Set wks = ActiveSheet

With wks
With .Range("C:C")
Set FoundCell = .Cells.Find(What:="Agent Name:", _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

End With

If FoundCell Is Nothing Then
MsgBox "Total not found in column C!"
Exit Sub
End If

tName = foundcell.offset(0,1).value
msgbox tname

End With
End Sub

Mahnian wrote:

I need a bit of code that will search through each cell in a column and look
for €œAgent Name:€� then choose cell to its right and create a new sheet with
the value of the selected cell as the name.

Below I have added what I tried, which obviously did not work. Any help on
this would be greatly appreciated. (Note, I can make the new sheet and name
it, so my test code just had a msgbox pop up with the value for testing)

=-=-=-=-=-=-=-=

Dim rngEdit As Range
Dim trow As Integer
Dim tcol As Integer
Dim tname As String

Sub LoopIt()
trow = 1
tcol = 3
Set rngEdit = ActiveSheet.Cells(trow, tcol)
Do Until rngEdit.Value = "Agent Name:"
trow = trow + 1
Loop
tcol = tcol + 1
tname = ActiveSheet.Cells(trow, tcol).Value
tcol = tcol - 1
MsgBox trow & " " & tcol
End Sub

--

Dave Peterson

Using Do Loops to copy data
 

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

Using Do Loops to copy data
 

Perfect, flawless, and more than I ever expected.

Thank you, sir.


"Dave Peterson" wrote:

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