PDA

View Full Version : Solved: Run Time 1004 error



austenr
01-05-2006, 02:14 PM
Anyone know why I would get this error on this code? It abends at the first ActiveSheet.Paste if the If statement is true. :banghead:

Sub CopyRows()
Sheets("Sheet1").Select
' Find the last row of data
FinalRow = Range("A65536").End(xlUp).Row
' Loop through each row
For x = 2 To FinalRow
' Decide if to copy based on column H
ThisValue = Range("E" & x).Value
If ThisValue = "MATCH" Then
Range("A" & x & ":C" & x).Copy
Sheets("Sheet2").Select
NextRow = Range("A65536").End(xlUp).Row + 1
Range("A" & NextRow).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ElseIf ThisValue = "No Match" Then
Range("A" & x & ":C" & x).Copy
Sheets("Sheet3").Select
NextRow = Range("A65536").End(xlUp).Row + 1
Range("A" & NextRow).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
End If
Next x
End Sub

Zack Barresse
01-05-2006, 02:42 PM
I recommend using the PasteSpecial method when pasting using VBA, it's quite tempermental if you don't.

...

Sub CopyRows()
Dim FinalRow As Long, NextRow As Long
' Sheets("Sheet1").Select
' Find the last row of data
FinalRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
' Loop through each row
For x = 2 To FinalRow
' Decide if to copy based on column H
ThisValue = Sheets("Sheet1").Range("E" & x).Value
If ThisValue = "MATCH" Then
NextRow = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets("Sheet1").Range("A" & x & ":C" & x).Copy
Sheets("Sheet2").Range("A" & NextRow).PasteSpecial xlPasteAll
ElseIf ThisValue = "No Match" Then
NextRow = Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets("Sheet1").Range("A" & x & ":C" & x).Copy
Sheets("Sheet3").Range("A" & NextRow).PasteSpecial xlPasteAll
End If
Next x
End Sub

That work for ya?

Btw, I think there is a way to do this without looping, but I don't really have much time right now to pick through what your code is doing exactly without seeing an example file. But off-hand, it appears this can be done in a few command lines rather than a loop.. I would think.

mvidas
01-05-2006, 02:43 PM
You could also just enter the destination in the Destination argument position:Sub CopyRows()
Dim x As Long, ThisValue As String
With Sheets("Sheet1")
For x = 2 To .Range("A65536").End(xlUp).Row
ThisValue = .Range("E" & x).Value
If ThisValue = "MATCH" Then
.Range("A" & x & ":C" & x).Copy Sheets("Sheet2").Range("A65536"). _
End(xlUp).Offset(1, 0)
ElseIf ThisValue = "No Match" Then
.Range("A" & x & ":C" & x).Copy Sheets("Sheet3").Range("A65536"). _
End(xlUp).Offset(1, 0)
End If
Next x
End With
End SubMatt

austenr
01-05-2006, 02:49 PM
Thanks Matt & Zack. Both work but I went with Matts since it is less code. Works as advertised. :clap:

mvidas
01-06-2006, 07:14 AM
Austenr,

Though it isn't necessary, and it is more code, this should be a bit faster depending on the size of your data. Its the only way I could think of doing it without looping, and after seeing the newest excel mvp (HUGE CONGRATULATIONS ZACK!) suggest a non-looping method, I figured why not try it :)Sub CopyRows()
Dim nWS As Worksheet, FNDf As Range, FNDl As Range
Application.ScreenUpdating = False
Sheets("Sheet1").Copy Before:=Sheets("Sheet1")
Set nWS = Sheets(Sheets("Sheet1").Index - 1)
nWS.Cells.Sort nWS.Columns(5), xlAscending, nWS.Columns(1), Order2:= _
xlAscending, Header:=xlYes
Set FNDf = nWS.Columns(5).Find("MATCH", LookIn:=xlValues, LookAt:= _
xlWhole, MatchCase:=xlTrue)
If Not FNDf Is Nothing Then
Set FNDl = nWS.Columns(5).Find("MATCH", SearchDirection:=xlPrevious)
Intersect(nWS.Range(FNDf, FNDl).EntireRow, nWS.Columns("A:C")).Copy _
Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
Set FNDf = nWS.Columns(5).Find("No Match", SearchDirection:=xlNext)
If Not FNDf Is Nothing Then
Set FNDl = nWS.Columns(5).Find("No Match", SearchDirection:=xlPrevious)
Intersect(nWS.Range(FNDf, FNDl).EntireRow, nWS.Columns("A:C")).Copy _
Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
Application.DisplayAlerts = False
nWS.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End SubMatt

austenr
01-06-2006, 07:38 AM
Thanks Matt.

austenr
01-06-2006, 08:38 AM
Having sorting problems now. Same error in the code after x is processed for the last time.


Sub CopyRows()
Application.ScreenUpdating = False
Dim FinalRow As Long, NextRow As Long
' Find the last row of data
FinalRow = Sheets("Sheet1").Cells(Rows.count, "A").End(xlUp).Row
' Loop through each row
For x = 2 To FinalRow
' Decide if to copy based on column E
ThisValue = Sheets("Sheet1").Range("E" & x).Value
If ThisValue = "MATCH" Then
NextRow = Sheets("Sheet2").Cells(Rows.count, "A").End(xlUp).Row + 1
Sheets("Sheet1").Range("A" & x & ":C" & x).Copy
Sheets("Sheet2").Range("A" & NextRow).PasteSpecial xlPasteAll
ElseIf ThisValue = "No Match" Then
NextRow = Sheets("Sheet3").Cells(Rows.count, "A").End(xlUp).Row + 1
Sheets("Sheet1").Range("A" & x & ":C" & x).Copy
Sheets("Sheet3").Range("A" & NextRow).PasteSpecial xlPasteAll
End If
Next x

Sheets("Sheet2").Range("A2:C1698").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.ScreenUpdating = True
End Sub

mvidas
01-06-2006, 08:43 AM
You can remove the .Select statement from there, and just use: Sheets("Sheet2").Range("A2:C1698").Sort Key1:=Sheets("Sheet2").Range("A2"), _
Order1:=xlAscending, Header:=xlNothough I think you'd be a little better off not hardcoding the range, like: Sheets("Sheet2").Range("A:C").Sort Key1:=Sheets("Sheet2").Columns("A"), _
Order1:=xlAscending, Header:=xlYesMatt

mvidas
01-06-2006, 08:47 AM
I'm curious though, did the code at http://www.vbaexpress.com/forum/showpost.php?p=53953&postcount=5 work for you? I just changed it to sort column A as well before copying, but you'd probably still need to sort after copying too. Just curious, worked on my test data but not sure how it would work for your real data.

austenr
01-06-2006, 08:51 AM
Yep.. Everything worked great. Sort included. Thanks Matt. Out of curiosity, why was I getting that error on the sort?

mvidas
01-06-2006, 09:13 AM
why was I getting that error on the sort?You may have gotten errors on the .Select line too (if sheet2 wasn't the active sheet). The reason you got the error on the sort was probably because your Range("A2") didnt have a sheet qualifier. Honestly, unless you changed sheets in mid-run, I don't really know why you would have gotten that error, but its better to be safe anyways. Using Selection causes errors a lot if you're not careful, so its better to avoid that and make sure everything is qualified :)