Do until loop

[Guest]

Hi,

I need the following to code to loop, but each time pasting one row further
down on Sheet 2 until the Control Find function finds "Ele NonRec END".



Cells.Find(What:="ele nonrec", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
Selection.Copy
Sheets("Sheet2").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Cells.Find(What:="record sent", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("I2").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Cells.Find(What:="global", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False).Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("X2").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Cells.Find(What:="o", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False) _
.Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("AD2").Select
ActiveSheet.Paste
Sheets("Sheet1").Select

Please help!! Thank you in advance.

John

 

[Don Guillett]

It appears that you are doing a lot of unnecessary work here. Selections
are NOT needed. You should be able to do this from anywhere in the workbook
without any selections.
It appears that you are looking for more than one instance of each of the
three text values??? Then, do you want to copy to the next available row on
the desired destination sheet?
If so, there is an excellent example of FINDNEXT in the vba help index. Or,
give exact details of what you are attempting.

 

[Jason Lepack]

Make a backup of your spreadsheet and in the backup test this code:

' - START OF CODE -
Option Explicit

Private Function lookForNext(s As String, r As Range, ws As Worksheet)
As Range
Set lookForNext = ws.Cells.Find(What:=s, After:=r,
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:=xlNext, _
MatchCase:=False)
End Function

Public Sub DoUntilJohnP()

On Error GoTo DOUJP_ERR

Dim wb As Workbook
Dim wsOld As Worksheet, wsNew As Worksheet
Dim rOld As Range, rNew As Range

Set wb = ActiveWorkbook
Set wsOld = wb.ActiveSheet
Set wsNew = wb.Sheets("Sheet2")

Set rOld = wsOld.Range("A1")
Set rOld = lookForNext("ele nonrec", rOld, wsOld)
Set rNew = wsNew.Range("A1")
If Not rOld Is Nothing Then
Do Until InStr(1, rOld.Formula, "ele nonrec END") > 0

rOld.Copy
Set rNew = rNew.Offset(1, 0)
rNew.PasteSpecial xlPasteAll

Set rOld = lookForNext("record sent", rOld, wsOld)
rOld.Copy
rNew.Offset(0, 8).PasteSpecial xlPasteAll

Set rOld = lookForNext("global", rOld, wsOld)
rOld.Copy
rNew.Offset(0, 23).PasteSpecial xlPasteAll

Set rOld = lookForNext("o", rOld, wsOld)
rOld.Copy
rNew.Offset(0, 29).PasteSpecial xlPasteAll

Set rOld = lookForNext("ele nonrec", rOld, wsOld)
Loop
Else
MsgBox "'ele nonrec' was not found in formulas of spreadsheet"
End If
DOUJP_GOODBYE:
Set rOld = Nothing
Set rNew = Nothing
Set wsOld = Nothing
Set wsNew = Nothing
Set wb = Nothing
Exit Sub
DOUJP_ERR:
MsgBox "NUMBER: " & Err.Number & vbCrLf & "DESCRIPTION:" & vbCrLf
& Err.Description
Resume DOUJP_GOODBYE
End Sub
' - END OF CODE -

 

[Guest]

Thanks Jason. The document on worksheet one is a report and all data is held
in the first column, I think this means that the "Option Explicit" part does
not work. The idea is to search for the common identifier in that cell, copy
the whole cell across and then text to column on worksheet 2 once the loop
macro has run. Does that make sense?

 

[Jason Lepack]

Nope, doesn't make sense at all.

Option Explicit isn't your problem. It just makes sure that all
variables are declared.

I just created code that did what yours did and then made it loop.
All yours did was copy the cell that had the formula and pasted it
into the specific cell in Sheet2.

I don't understand what you are asking. What happens when you run the
code? What should happen?

Cheers,
Jason Lepack

 

[Guest]

Sorry, you can probably tell that I'm new to this!!

I was having problems with the way it had pasted but it works perfectly now.
Thank you so much.

DOUJP_ERR:
MsgBox "NUMBER: " & Err.Number & vbCrLf & "DESCRIPTION:" & vbCrLf
& Err.Description
Resume DOUJP_GOODBYE
End Sub

 

[Jason Lepack]

Ah, sorry. I should have warned about that.

Cheers!