Looping...but why?

G

Guest

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
 
O

Otto Moehrbach

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
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

conso macro 0
If Cells.Find returns run-time error '91': Object variableor With block variable not set 1
Data Cleanse Macro Running Very Slow 0
Need help with a "If" "Else" VB code 4
find and replace multiple values in one statement 3
Macro to select columns and replace data 6
Error for a replace. It replace ALL instead of selected column 2
On error goto specified Line 6

Top