| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Do until loop
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 |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Do until loop
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 - On Feb 22, 8:07 am, JohnP wrote: 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 |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Do until loop
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" wrote: 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 - On Feb 22, 8:07 am, JohnP wrote: 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 |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Do until loop
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 On Feb 22, 11:06 am, JohnP wrote: 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" wrote: 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 - On Feb 22, 8:07 am, JohnP wrote: 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- Hide quoted text - - Show quoted text - |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Do until loop
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" wrote: 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 On Feb 22, 11:06 am, JohnP wrote: 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" wrote: 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 - On Feb 22, 8:07 am, JohnP wrote: 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- Hide quoted text - - Show quoted text - |
|
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Do until loop
Ah, sorry. I should have warned about that.
Cheers! On Feb 22, 12:08 pm, JohnP wrote: 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" wrote: 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 On Feb 22, 11:06 am, JohnP wrote: 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" wrote: 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 - On Feb 22, 8:07 am, JohnP wrote: 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- Hide quoted text - - Show quoted text -- Hide quoted text - - Show quoted text - |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| For Each ... Next loop - need to reference the loop variable | Excel Programming | |||
| Advancing outer Loop Based on criteria of inner loop | Excel Programming | |||
| Loop Function unable to loop | Excel Programming | |||
| Problem adding charts using Do-Loop Until loop | Excel Programming | |||
| HELP!!!! Can't stop a loop (NOT an infinite loop) | Excel Programming | |||
Linear Mode
