Looping...but why?

cherrynich · May 12, 2006

Help! my code runs and then reruns until it gets stopped halfway through the
second run. I want it to only run once.
Here's the code:
Windows("Paid Service Call Report.xls").Activate
Columns("A:A").Select
Range("A3").Activate
ActiveCell.Replace What:="Christopher, John ", Replacement:= _
"Chistopher, John ", LookAt:=xlPart, SearchOrder:=xlByRows,
MatchCase:= _
False, SearchFormat:=False, ReplaceFormat:=False

ActiveCell.Replace What:="Christopher, John ", Replacement:= _
"Chistopher, John ", LookAt:=xlPart, SearchOrder:=xlByRows,
MatchCase:= _
False, SearchFormat:=False, ReplaceFormat:=False

Windows("earnings.xls").Activate
Range("A1").Select
Dim R As Long
Dim C As Range
Dim Rng As Range

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

If Selection.Rows.Count > 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If
For R = Rng.Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountA(Rng.Rows(R).EntireRow) = 0 Then
Rng.Rows(R).EntireRow.Delete
End If
Next R

EndMacro:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Dim rngBB As Range, rngFound As Range
Dim rngAA As Range
Dim x1 As Integer, x2 As Integer

Set rngBB = Range("B:B")
Set rngAA = Range("A:A")

Set rngFound = rngBB.Find(What:="Service Calls", LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False)

If Not rngFound Is Nothing Then
x1 = rngFound.Row

End If

Set rngFound = Nothing
Set rngFound = rngAA.Find(What:="sc totals", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)

If Not rngFound Is Nothing Then
x2 = rngFound.Row

End If
Range(x1 & ":" & x2).EntireRow.Select
Selection.Cut
Workbooks.Add
ActiveSheet.Paste
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Columns("C:H").Select
Selection.Delete Shift:=xlToLeft
Range("B1").Select
ActiveCell.FormulaR1C1 = "Employee"
Range("B2").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],LEN(RC[-1])-1)"
Range("B2").Select
Selection.AutoFill Destination:=Range("B2:B200")
Range("B2:B200").Select
Columns("B:B").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1:B1000").Select
ActiveWorkbook.Names.Add Name:="LISTER",
RefersToR1C1:="=Sheet1!R1C1:R1000C2"
Selection.Copy

Windows("paid service call report.xls").Activate
Sheets("Sheet1").Select
ActiveSheet.Paste
Range("A1:B1000").Select
Application.CutCopyMode = False
ActiveWorkbook.Names.Add Name:="tech", RefersToR1C1:="=Sheet1!R1C1:R300C2"
Columns("A:A").Select
ActiveCell.Replace What:="Smith, Michael", Replacement:="Smith, Michael
A" _
, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False,
SearchFormat _
:=False, ReplaceFormat:=False
Selection.Find(What:="Smith, Michael", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Replace What:="Smith, Michael", Replacement:="Smith, Michael
A" _
, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False,
SearchFormat _
:=False, ReplaceFormat:=False
Selection.Find(What:="Smith, Michael", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Replace What:="Smith, Michael", Replacement:="Smith, Michael
R" _
, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False,
SearchFormat _
:=False, ReplaceFormat:=False
Selection.Find(What:="Smith, Michael", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Columns("A:A").EntireColumn.AutoFit

Sheets("paid service call report").Select
Range("A1").Select
Range("B3:B187").Select
Selection.Delete Shift:=xlToLeft
Range("G3:G187").Select
Selection.Insert Shift:=xlToRight
With Selection.Interior
.ColorIndex = 2
.Pattern = xlSolid
End With
Range("G4").Select
ActiveCell.FormulaR1C1 = _

"=IF(ISERROR(VLOOKUP(RC[-6],tech,2,FALSE)),0,(IF(VLOOKUP(RC[-6],tech,2,FALSE)<0,ABS(VLOOKUP(RC[-6],tech,2,FALSE)),0)))"
Range("G4").Select
Selection.AutoFill Destination:=Range("G5:G188")
Range("G4:G188").Select
ActiveWindow.SmallScroll Down:=156
Sheets("Sheet1").Select
ActiveWindow.SmallScroll Down:=45
Sheets("paid service call report").Select

Range("A5").Select
Range("G2:G3").Select
Selection.Interior.ColorIndex = 13
Selection.Font.ColorIndex = 2
Range("G2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]+14"
Range("G3").Select
ActiveCell.FormulaR1C1 = "='[earnings.xls]Earnings Taken'!R4C7"
Range("G3").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

ActiveCell.Replace What:="/2006", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Find(What:="/2006", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
Range("G4:G188").Select
Application.CutCopyMode = False
Selection.Copy

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Application.CutCopyMode = False
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlGreaterEqual _
, Formula1:="30"
Selection.FormatConditions(1).Interior.ColorIndex = 6

Range("G188").Select
Selection.ClearContents
Range("H187").Select
Selection.Copy
Range("G187").Select
ActiveSheet.Paste

Range("A1:H2").Select
Range("H5").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUM(RC[-6]:RC[-1])"
Range("H5").Select
Selection.AutoFill Destination:=Range("H5:H187")
Range("H5:H187").Select

ActiveCell.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1:H2").Select
Application.CutCopyMode = False
Range("G4").Select
ActiveCell.Replace What:="Pay Period:", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Range("A1:H2").Select

End Sub

Ivan Raiminius · May 12, 2006

Hi,

have a look at:

http://www.cpearson.com/excel/Debug.htm

especially break points and stepping through code might be interesting
for you.

Regards,
Ivan

Otto Moehrbach · May 12, 2006

It's very difficult to follow that much code. You could post back and
explain the code logic to make it clearer. One thing I see that could be a
problem is your error trap. You invoke the trap with the statement:
On Error GoTo EndMacro
but you never cancel the trap. As written, that trap will stay in force as
long as the code is running. That means that if the code encounters an
error anywhere from the error trap statement above to the End Sub line at
the end of the macro, the code will revert (GoTo) back to the "EndMacro"
line. This would cause a repetition of some of the code.
Also I don't see what error you want to trap anywhere between the above
error trap line and the "EndMacro" line. Post back and clarify what you are
wanting to do with that error trap.
Also, it appears that you duplicate your Replace commands, or some of
them. For instance, these 2 statements appear to be the same and they work
on the same range:
ActiveCell.Replace What:="Christopher, John ", Replacement:= _
"Chistopher, John ", LookAt:=xlPart, SearchOrder:=xlByRows,
MatchCase:= _
False, SearchFormat:=False, ReplaceFormat:=False

ActiveCell.Replace What:="Christopher, John ", Replacement:= _
"Chistopher, John ", LookAt:=xlPart, SearchOrder:=xlByRows,
MatchCase:= _
False, SearchFormat:=False, ReplaceFormat:=False

Post back and explain in a step-by-step fashion what you are wanting this
code to do and I'll work with you to find what is wrong. HTH Otto

cherrynich said:
Help! my code runs and then reruns until it gets stopped halfway through
the
second run. I want it to only run once.
Here's the code:
Windows("Paid Service Call Report.xls").Activate
Columns("A:A").Select
Range("A3").Activate
ActiveCell.Replace What:="Christopher, John ", Replacement:= _
"Chistopher, John ", LookAt:=xlPart, SearchOrder:=xlByRows,
MatchCase:= _
False, SearchFormat:=False, ReplaceFormat:=False

ActiveCell.Replace What:="Christopher, John ", Replacement:= _
"Chistopher, John ", LookAt:=xlPart, SearchOrder:=xlByRows,
MatchCase:= _
False, SearchFormat:=False, ReplaceFormat:=False

Windows("earnings.xls").Activate
Range("A1").Select
Dim R As Long
Dim C As Range
Dim Rng As Range

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

If Selection.Rows.Count > 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If
For R = Rng.Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountA(Rng.Rows(R).EntireRow) = 0 Then
Rng.Rows(R).EntireRow.Delete
End If
Next R

EndMacro:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Dim rngBB As Range, rngFound As Range
Dim rngAA As Range
Dim x1 As Integer, x2 As Integer

Set rngBB = Range("B:B")
Set rngAA = Range("A:A")

Set rngFound = rngBB.Find(What:="Service Calls", LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False)

If Not rngFound Is Nothing Then
x1 = rngFound.Row

End If

Set rngFound = Nothing
Set rngFound = rngAA.Find(What:="sc totals", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)

If Not rngFound Is Nothing Then
x2 = rngFound.Row

End If
Range(x1 & ":" & x2).EntireRow.Select
Selection.Cut
Workbooks.Add
ActiveSheet.Paste
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Columns("C:H").Select
Selection.Delete Shift:=xlToLeft
Range("B1").Select
ActiveCell.FormulaR1C1 = "Employee"
Range("B2").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],LEN(RC[-1])-1)"
Range("B2").Select
Selection.AutoFill Destination:=Range("B2:B200")
Range("B2:B200").Select
Columns("B:B").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1:B1000").Select
ActiveWorkbook.Names.Add Name:="LISTER",
RefersToR1C1:="=Sheet1!R1C1:R1000C2"
Selection.Copy

Windows("paid service call report.xls").Activate
Sheets("Sheet1").Select
ActiveSheet.Paste
Range("A1:B1000").Select
Application.CutCopyMode = False
ActiveWorkbook.Names.Add Name:="tech",
RefersToR1C1:="=Sheet1!R1C1:R300C2"
Columns("A:A").Select
ActiveCell.Replace What:="Smith, Michael", Replacement:="Smith, Michael
A" _
, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False,
SearchFormat _
:=False, ReplaceFormat:=False
Selection.Find(What:="Smith, Michael", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Replace What:="Smith, Michael", Replacement:="Smith, Michael
A" _
, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False,
SearchFormat _
:=False, ReplaceFormat:=False
Selection.Find(What:="Smith, Michael", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Replace What:="Smith, Michael", Replacement:="Smith, Michael
R" _
, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False,
SearchFormat _
:=False, ReplaceFormat:=False
Selection.Find(What:="Smith, Michael", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Columns("A:A").EntireColumn.AutoFit

Sheets("paid service call report").Select
Range("A1").Select
Range("B3:B187").Select
Selection.Delete Shift:=xlToLeft
Range("G3:G187").Select
Selection.Insert Shift:=xlToRight
With Selection.Interior
.ColorIndex = 2
.Pattern = xlSolid
End With
Range("G4").Select
ActiveCell.FormulaR1C1 = _

"=IF(ISERROR(VLOOKUP(RC[-6],tech,2,FALSE)),0,(IF(VLOOKUP(RC[-6],tech,2,FALSE)<0,ABS(VLOOKUP(RC[-6],tech,2,FALSE)),0)))"
Range("G4").Select
Selection.AutoFill Destination:=Range("G5:G188")
Range("G4:G188").Select
ActiveWindow.SmallScroll Down:=156
Sheets("Sheet1").Select
ActiveWindow.SmallScroll Down:=45
Sheets("paid service call report").Select

Range("A5").Select
Range("G2:G3").Select
Selection.Interior.ColorIndex = 13
Selection.Font.ColorIndex = 2
Range("G2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]+14"
Range("G3").Select
ActiveCell.FormulaR1C1 = "='[earnings.xls]Earnings Taken'!R4C7"
Range("G3").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

ActiveCell.Replace What:="/2006", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Find(What:="/2006", After:=ActiveCell, LookIn:=xlFormulas, LookAt
_
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
Range("G4:G188").Select
Application.CutCopyMode = False
Selection.Copy

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Application.CutCopyMode = False
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlGreaterEqual _
, Formula1:="30"
Selection.FormatConditions(1).Interior.ColorIndex = 6

Range("G188").Select
Selection.ClearContents
Range("H187").Select
Selection.Copy
Range("G187").Select
ActiveSheet.Paste

Range("A1:H2").Select
Range("H5").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUM(RC[-6]:RC[-1])"
Range("H5").Select
Selection.AutoFill Destination:=Range("H5:H187")
Range("H5:H187").Select

ActiveCell.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1:H2").Select
Application.CutCopyMode = False
Range("G4").Select
ActiveCell.Replace What:="Pay Period:", Replacement:="",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Range("A1:H2").Select

End Sub

If Cells.Find returns run-time error '91': Object variableor With block variable not set	1	Nov 13, 2012
Need help with correct syntax please	2	Nov 4, 2013
find and replace multiple values in one statement	3	Mar 5, 2010
Finding a range and performing a function	2	May 12, 2010
Array code only works on selected sheet	14	Nov 23, 2013
Find copy data from a cell in Personal workbook and copy it to a cellin current workbook	14	Jun 20, 2013
Set Column choice to a variable from a Drop Down	4	Oct 30, 2013
Getting Excel Find to Default to Searching Workbook not Sheet	3	Sep 24, 2012

Looping...but why?

cherrynich

Ivan Raiminius

Otto Moehrbach

Ask a Question

Similar Threads