Copy Macro Throws 1004 Error

[Legacy 177103]

I'm writing this to query the database, sort the query, select rows of like values in column A, copy them over to another sheet, then email the results to specific contacts to that customer in column A.

I was going step by step, and I encountered this issue, so I didnt get the whole thing done. I tried stopping it at just one customer by telling it to go to endmacro when it wasnt equal, and that worked fine. When I tried letting it copy ALL Customers over, it stopped at line 172 and threw a 1004 Error for User Defined Object here:
ToO.Rows(Countw).Value = FrO.Rows(Countw).Value

Any help is appreciated.

Sub status_send()
Dim ROpen As Long, RShipped As Long, Countr As Long, Counts As Long, Countt As Long
Dim OpenRng As Range, ShippedRng As Range
Countr = 4
Counts = 4

Dim StrConn As String 'Save connection string
dsn = "sql"
StrConn = "ODBC;DSN="
StrConn = StrConn & dsn
StrConn = StrConn & ";UID=info;PWD=;APP=????????;WSID=?;DATABASE=hpinfo;Network=DBMSSOCN"
Dim w As Worksheet, p As PivotTable, q As QueryTable, c As Chart

For Each w In ThisWorkbook.Worksheets 'Refresh Queries on all worksheets and sort
    For Each q In w.QueryTables
        q.Connection = StrConn
        q.Refresh BackgroundQuery:=False
Next
Next

'Sort columns ascending by customer
Worksheets("Open_Data").Range("A3").Sort Key1:=Worksheets("Open_Data").Range("A3"), Order1:=xlAscending, Header:= _
    xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
Worksheets("Shipped_Data").Range("A3").Sort Key1:=Worksheets("Shipped_Data").Range("A3"), Order1:=xlAscending, Header:= _
    xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal

'Set Ranges and find rows
Set FrO = Worksheets("Open_Data"): Set FrS = Worksheets("Shipped_Data")
Set ToO = Worksheets("Open_Orders"): Set ToS = Worksheets("Shipped_Orders")
Set OpenRng = Worksheets("Open_Data").Range("A4").SpecialCells(xlCellTypeLastCell)
Set ShippedRng = Worksheets("Shipped_Data").Range("A4").SpecialCells(xlCellTypeLastCell)
ROpen = OpenRng.Row: RShipped = ShippedRng.Row

Loopt:
'Set tops of each new report page
ToO.Rows(3).Value = FrO.Rows(3).Value: ToS.Rows(3).Value = FrS.Rows(3).Value
ToO.Rows(Countr).Value = FrO.Rows(Countr).Value: ToS.Rows(Counts).Value = FrS.Rows(Counts).Value

Countr = Countr + 1: Counts = Counts + 1

'Build Open Orders for Customer
For Countt = Countr To ROpen Step 1
If FrO.Range("A" & Countt).Value = FrO.Range("A" & (Countt - 1)).Value Then
ToO.Rows(Countw).Value = FrO.Rows(Countw).Value
ElseIf FrO.Range("A" & Countt).Value <> FrO.Range("A" & (Countt - 1)).Value Then
GoTo ShpOrd
End If
Next

'Build Shipped ORders For Customer
ShpOrd:
For Countw = Counts To RShipped Step 1
If FrS.Range("A" & Countw).Value = FrS.Range("A" & (Countw - 1)).Value Then
ToS.Rows(Countw).Value = FrS.Rows(Countw).Value
ElseIf FrS.Range("A" & Countw).Value <> FrS.Range("A" & (Countw - 1)).Value Then
GoTo Loopt
End If
Next

'End the Macro and Report Lines
EndMacro:

MsgBox "Number of Rows: " & ROpen & " / " & RShipped 'Display the number of rows

End Sub

 

[shg]

What's the value of countw when the line fails?

Are there any merged cells?

 

[Legacy 177103]

The value is also 172. There are no merged cells.

 

[shg]

Protected sheet?

 

[Legacy 177103]

It's not protected, no.
It works all the way up until line 172 then stops and throws the error. It should go all the way to the last line before it stops.
Maybe it's memory issues?

 

[shg]

Do any of the cells contain array formulas?

Is the cell protection the same in both rows (all locked or unlocked, irrespective of whether the sheet is protected)?

After the code stops, can you do the exact operation manually on those rows?

 

[Legacy 177103]

I'd have to wait till I get to work tomorrow to see if I can do it manually. I'm pretty sure I can, but I'll check anyway. The only thing special about any of the two data sheets that I'm pulling info from are populated from query tables. There's no functions involved in either of the sheets.

 

[Legacy 177103]

After doing some digging, I believe the error is a part of this microsoft problem.

http://support.microsoft.com/default.aspx?scid=kb;en-us;210684&Product=xlw

They say if you try to copy out of a page too many times it'll throw the error. Their work around is that you save and close the workbook occasionally(They use a If Counter Mod 100 = 0 solution).

 

[shg]

I'm well aware of that bug, but don't see how it relates to your problem. You're not copying a sheet when the problem occurs.

 

[Norie]

This is just a shot in the dark but could the problem be setting entire rows to the values from other rows.

If you use entire row it's is a fair amount of cells, and obviously if it's multiple rows is even more cells.

Why not try a standard copy/paste special values or only working with the relevant columns in the rows instead of all of them.

Just an idea.

Another shot in the dark - you seem to be jumping about a fair bit in the code, using Gotos etc.

That's not a good idea usual and perhaps because of it the code/Excel has got all tangled up and confused.

Poor thing.