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

 

[Legacy 177103]

I agree. Jumping out of unfinished loops leaves them open in memory, but I thought it would be ok because they eventually meet the conditions and close. Ill restructure them to close for each customer then cycle back around for the next customer. The reason I didn't use good ol copy paste is because I wanted to avoid selecting.
I might also try dynamic ranges to copy the needed rows/columns.
Thanks for all the help you guys provided to not only me, but the hundreds of viewers on these forums.

 

[Norie]

Glad you've got a solution but I'm pretty sure it's nothing to do with leaving the loops open memory.

I've never even heard of that.

Basically what I meant was that the code was jumping about all over the place.

That might not have been the actual problem but I'm pretty sure it didn't help.

It certainly made it harder to see what was happening in the code.

Anyway, like I said - glad you've got a solution.