Code hangs second time around

T

Tom

Hi gang,
The code below runs FINE when I first open Excel and run the macro. However,
if I run the macro a second time, it hangs and I have to press the ESC button
to get it to stop. If I completely close down Excel and re-open the file, the
macro will once again run properly if ran only once. Unfortunately, the only
message I get is that the "code has been interrupted" and it does not show me
which line has the error in it. I'm not even sure which of the two macros it
is hanging on. Any ideas???

Sub Filter()
Dim MyRange As Range
Set MyRange = Sheets("DATA").Range("C17:C23")
For x = 400 To 1 Step -1
myvalue = Cells(x, 36).Value
For Each c In MyRange
If myvalue = c.Value Then
Rows(x).EntireRow.Delete
Exit For
End If
Next
Next
Set MyRange = Sheets("DATA").Range("D17:D18")
For x = 400 To 1 Step -1
myvalue = Cells(x, 31).Value
For Each c In MyRange
If myvalue = c.Value Then
Rows(x).EntireRow.Delete
Exit For
End If
Next
Next
Application.Run "GetOurs"
End Sub
-----------------------------------------------------------------------------------------------
Sub GetOurs()
Application.ScreenUpdating = False
Sheets("Conversions").Visible = True
Sheets("Conversions").Select
Range("I3:I200").Select
Selection.Copy
Sheets("FRMLST").Select
Range("W3:W200").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("Conversions").Select
Range("M3:M200").Select
Selection.Copy
Sheets("FRMLST").Select
Range("X3:X200").Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("Z1").Select
Selection.AutoFill Destination:=Range("Z1:Z200"), Type:=xlFillDefault
Range("Z1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="<>"
Columns("Z:Z").Select
Selection.Copy
Range("E3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("Z1").Select
Selection.AutoFilter
Range("F3").Select
ActiveCell.FormulaR1C1 = _

"=IF(ISNA(VLOOKUP(R[0]C[-1],R1C27:R250C29,3,0)),"""",VLOOKUP(R[0]C[-1],R1C27:R250C29,3,0))"
Range("G3").Select
ActiveCell.FormulaR1C1 = _

"=IF(ISNA(VLOOKUP(R[0]C[-2],R1C27:R250C35,9,0)),"""",VLOOKUP(R[0]C[-2],R1C27:R250C35,9,0))"
Range("F3").Select
Selection.AutoFill Destination:=Range("F3:F50"), Type:=xlFillDefault
Range("F3:F50").Select
Range("G3").Select
Selection.AutoFill Destination:=Range("G3:G50"), Type:=xlFillDefault
Range("G3:G50").Select
Range("F1:G2").Select
Selection.ClearContents
Range("D1").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[2]C[1]>0,""PLEASE CHECK THE FOLLOWING FORMULAS"",""ALL
FORMULAS ARE CURRENT"")"
Range("D1").Select
Range("B4").Select
Sheets("Conversions").Visible = False
Application.ScreenUpdating = True
End Sub
 
J

Joel

I had problems gettting the code to work the first time. Th e functtion
filter doesn't make sense if yu are working with one sheet. I think there
should be two sheets in function filter.

In filter you are going from row 400 to 1, then searching in the middle of
this range, then deleting in this range. Can't be done!

I also found a problem with one of you copy instructions. You are copying
an entire column Z and then trying to paste it starting at cell E3. The last
3 rows of the paste will go off the end off the worksheet. I change the
selection to the following

Range("Z1", Range("Z" & Rows.Count).End(xlUp)).Select





Sub Filter()
Dim MyRange As Range
Set MyRange = Sheets("DATA").Range("C17:C23")
For x = 400 To 1 Step -1
With Sheets("sheet1")
myvalue = .Cells(x, 36).Value
For Each c In MyRange
If myvalue = c.Value Then
.Rows(x).EntireRow.Delete
Exit For
End If
Next
End With
Next
Set MyRange = Sheets("DATA").Range("D17:D18")
For x = 400 To 1 Step -1
With Sheets("sheet1")
myvalue = .Cells(x, 31).Value
For Each c In MyRange
If myvalue = c.Value Then
.Rows(x).EntireRow.Delete
Exit For
End If
Next
End With
Next
Call GetOurs
End Sub

Sub GetOurs()
Application.ScreenUpdating = False
Sheets("Conversions").Visible = True
Sheets("Conversions").Select
Range("I3:I200").Select
Selection.Copy
Sheets("FRMLST").Select
Range("W3:W200").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("Conversions").Select
Range("M3:M200").Select
Selection.Copy
Sheets("FRMLST").Select
Range("X3:X200").Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("Z1").Select
Selection.AutoFill Destination:=Range("Z1:Z200"), Type:=xlFillDefault
Range("Z1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="<>"
Range("Z1", Range("Z" & Rows.Count).End(xlUp)).Select
Selection.Copy
Range("E3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("Z1").Select
Selection.AutoFilter
Range("F3").Select
ActiveCell.FormulaR1C1 =
"=IF(ISNA(VLOOKUP(R[0]C[-1],R1C27:R250C29,3,0)),"""",VLOOKUP(R[0]C[-1],R1C27:R250C29,3,0))"
Range("G3").Select
ActiveCell.FormulaR1C1 =
"=IF(ISNA(VLOOKUP(R[0]C[-2],R1C27:R250C35,9,0)),"""",VLOOKUP(R[0]C[-2],R1C27:R250C35,9,0))"
Range("F3").Select
Selection.AutoFill Destination:=Range("F3:F50"), Type:=xlFillDefault
Range("F3:F50").Select
Range("G3").Select
Selection.AutoFill Destination:=Range("G3:G50"), Type:=xlFillDefault
Range("G3:G50").Select
Range("F1:G2").Select
Selection.ClearContents
Range("D1").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[2]C[1]>0,""PLEASE CHECK THE FOLLOWING FORMULAS"",""ALL
FORMULAS ARE CURRENT"")"
Range("D1").Select
Range("B4").Select
Sheets("Conversions").Visible = False
Application.ScreenUpdating = True
End Sub


Tom said:
Hi gang,
The code below runs FINE when I first open Excel and run the macro. However,
if I run the macro a second time, it hangs and I have to press the ESC button
to get it to stop. If I completely close down Excel and re-open the file, the
macro will once again run properly if ran only once. Unfortunately, the only
message I get is that the "code has been interrupted" and it does not show me
which line has the error in it. I'm not even sure which of the two macros it
is hanging on. Any ideas???

Sub Filter()
Dim MyRange As Range
Set MyRange = Sheets("DATA").Range("C17:C23")
For x = 400 To 1 Step -1
myvalue = Cells(x, 36).Value
For Each c In MyRange
If myvalue = c.Value Then
Rows(x).EntireRow.Delete
Exit For
End If
Next
Next
Set MyRange = Sheets("DATA").Range("D17:D18")
For x = 400 To 1 Step -1
myvalue = Cells(x, 31).Value
For Each c In MyRange
If myvalue = c.Value Then
Rows(x).EntireRow.Delete
Exit For
End If
Next
Next
Application.Run "GetOurs"
End Sub
-----------------------------------------------------------------------------------------------
Sub GetOurs()
Application.ScreenUpdating = False
Sheets("Conversions").Visible = True
Sheets("Conversions").Select
Range("I3:I200").Select
Selection.Copy
Sheets("FRMLST").Select
Range("W3:W200").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("Conversions").Select
Range("M3:M200").Select
Selection.Copy
Sheets("FRMLST").Select
Range("X3:X200").Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("Z1").Select
Selection.AutoFill Destination:=Range("Z1:Z200"), Type:=xlFillDefault
Range("Z1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="<>"
Columns("Z:Z").Select
Selection.Copy
Range("E3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("Z1").Select
Selection.AutoFilter
Range("F3").Select
ActiveCell.FormulaR1C1 = _

"=IF(ISNA(VLOOKUP(R[0]C[-1],R1C27:R250C29,3,0)),"""",VLOOKUP(R[0]C[-1],R1C27:R250C29,3,0))"
Range("G3").Select
ActiveCell.FormulaR1C1 = _

"=IF(ISNA(VLOOKUP(R[0]C[-2],R1C27:R250C35,9,0)),"""",VLOOKUP(R[0]C[-2],R1C27:R250C35,9,0))"
Range("F3").Select
Selection.AutoFill Destination:=Range("F3:F50"), Type:=xlFillDefault
Range("F3:F50").Select
Range("G3").Select
Selection.AutoFill Destination:=Range("G3:G50"), Type:=xlFillDefault
Range("G3:G50").Select
Range("F1:G2").Select
Selection.ClearContents
Range("D1").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[2]C[1]>0,""PLEASE CHECK THE FOLLOWING FORMULAS"",""ALL
FORMULAS ARE CURRENT"")"
Range("D1").Select
Range("B4").Select
Sheets("Conversions").Visible = False
Application.ScreenUpdating = True
End Sub
Click to expand...
 
T

Tom

Joel,
Thanks for taking the time to look at the code.
In "Filter", I only set the range to 400 because that would ensure that it
would include all of my data. the actual data only goes down to ABOUT row
350, but changes somewhat from time to time...so I made it 400 to ensure that
any change would be included.

The same principle applies to the copy and paste from Z:Z to E3....the data
again is USUALLY only down to row 350, but varies as much as down to about
375 or so at times. That being said, there isn't an issue with running off of
the end of the sheet.

As I said, this code DOES work....as long as it's run only once...running
the second time, it hangs and Excel must be shut down completely before it
will work again. I'm thinking that there must be something that has to be
"reset" to run the code more than once without having to shut down Excel?

Joel said:
I had problems gettting the code to work the first time. Th e functtion
filter doesn't make sense if yu are working with one sheet. I think there
should be two sheets in function filter.

In filter you are going from row 400 to 1, then searching in the middle of
this range, then deleting in this range. Can't be done!

I also found a problem with one of you copy instructions. You are copying
an entire column Z and then trying to paste it starting at cell E3. The last
3 rows of the paste will go off the end off the worksheet. I change the
selection to the following

Range("Z1", Range("Z" & Rows.Count).End(xlUp)).Select





Sub Filter()
Dim MyRange As Range
Set MyRange = Sheets("DATA").Range("C17:C23")
For x = 400 To 1 Step -1
With Sheets("sheet1")
myvalue = .Cells(x, 36).Value
For Each c In MyRange
If myvalue = c.Value Then
.Rows(x).EntireRow.Delete
Exit For
End If
Next
End With
Next
Set MyRange = Sheets("DATA").Range("D17:D18")
For x = 400 To 1 Step -1
With Sheets("sheet1")
myvalue = .Cells(x, 31).Value
For Each c In MyRange
If myvalue = c.Value Then
.Rows(x).EntireRow.Delete
Exit For
End If
Next
End With
Next
Call GetOurs
End Sub

Sub GetOurs()
Application.ScreenUpdating = False
Sheets("Conversions").Visible = True
Sheets("Conversions").Select
Range("I3:I200").Select
Selection.Copy
Sheets("FRMLST").Select
Range("W3:W200").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("Conversions").Select
Range("M3:M200").Select
Selection.Copy
Sheets("FRMLST").Select
Range("X3:X200").Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("Z1").Select
Selection.AutoFill Destination:=Range("Z1:Z200"), Type:=xlFillDefault
Range("Z1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="<>"
Range("Z1", Range("Z" & Rows.Count).End(xlUp)).Select
Selection.Copy
Range("E3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("Z1").Select
Selection.AutoFilter
Range("F3").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISNA(VLOOKUP(R[0]C[-1],R1C27:R250C29,3,0)),"""",VLOOKUP(R[0]C[-1],R1C27:R250C29,3,0))"
Range("G3").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISNA(VLOOKUP(R[0]C[-2],R1C27:R250C35,9,0)),"""",VLOOKUP(R[0]C[-2],R1C27:R250C35,9,0))"
Range("F3").Select
Selection.AutoFill Destination:=Range("F3:F50"), Type:=xlFillDefault
Range("F3:F50").Select
Range("G3").Select
Selection.AutoFill Destination:=Range("G3:G50"), Type:=xlFillDefault
Range("G3:G50").Select
Range("F1:G2").Select
Selection.ClearContents
Range("D1").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[2]C[1]>0,""PLEASE CHECK THE FOLLOWING FORMULAS"",""ALL
FORMULAS ARE CURRENT"")"
Range("D1").Select
Range("B4").Select
Sheets("Conversions").Visible = False
Application.ScreenUpdating = True
End Sub


Tom said:
Hi gang,
The code below runs FINE when I first open Excel and run the macro. However,
if I run the macro a second time, it hangs and I have to press the ESC button
to get it to stop. If I completely close down Excel and re-open the file, the
macro will once again run properly if ran only once. Unfortunately, the only
message I get is that the "code has been interrupted" and it does not show me
which line has the error in it. I'm not even sure which of the two macros it
is hanging on. Any ideas???

Sub Filter()
Dim MyRange As Range
Set MyRange = Sheets("DATA").Range("C17:C23")
For x = 400 To 1 Step -1
myvalue = Cells(x, 36).Value
For Each c In MyRange
If myvalue = c.Value Then
Rows(x).EntireRow.Delete
Exit For
End If
Next
Next
Set MyRange = Sheets("DATA").Range("D17:D18")
For x = 400 To 1 Step -1
myvalue = Cells(x, 31).Value
For Each c In MyRange
If myvalue = c.Value Then
Rows(x).EntireRow.Delete
Exit For
End If
Next
Next
Application.Run "GetOurs"
End Sub
-----------------------------------------------------------------------------------------------
Sub GetOurs()
Application.ScreenUpdating = False
Sheets("Conversions").Visible = True
Sheets("Conversions").Select
Range("I3:I200").Select
Selection.Copy
Sheets("FRMLST").Select
Range("W3:W200").Select
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("Conversions").Select
Range("M3:M200").Select
Selection.Copy
Sheets("FRMLST").Select
Range("X3:X200").Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("Z1").Select
Selection.AutoFill Destination:=Range("Z1:Z200"), Type:=xlFillDefault
Range("Z1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="<>"
Columns("Z:Z").Select
Selection.Copy
Range("E3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("Z1").Select
Selection.AutoFilter
Range("F3").Select
ActiveCell.FormulaR1C1 = _

"=IF(ISNA(VLOOKUP(R[0]C[-1],R1C27:R250C29,3,0)),"""",VLOOKUP(R[0]C[-1],R1C27:R250C29,3,0))"
Range("G3").Select
ActiveCell.FormulaR1C1 = _

"=IF(ISNA(VLOOKUP(R[0]C[-2],R1C27:R250C35,9,0)),"""",VLOOKUP(R[0]C[-2],R1C27:R250C35,9,0))"
Range("F3").Select
Selection.AutoFill Destination:=Range("F3:F50"), Type:=xlFillDefault
Range("F3:F50").Select
Range("G3").Select
Selection.AutoFill Destination:=Range("G3:G50"), Type:=xlFillDefault
Range("G3:G50").Select
Range("F1:G2").Select
Selection.ClearContents
Range("D1").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[2]C[1]>0,""PLEASE CHECK THE FOLLOWING FORMULAS"",""ALL
FORMULAS ARE CURRENT"")"
Range("D1").Select
Range("B4").Select
Sheets("Conversions").Visible = False
Application.ScreenUpdating = True
End Sub
Click to expand...
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

macro to copy rows that contain a cell with a certain number 3
Error 2007 0
Problem Applying Formula to cell 2
Vlookup in vba - how to use absolute rows not relative 1
how do I write a loop macro? 9
= Today()+1 into Sheet1, Sheet2, and Sheet3 2
Totals An Easier Way?? 5
cannot insert row in vba 1

Top