Need offset range for loop

[Joe Fish]

Hi,
I have a sub that works fine until I try to loop it. It analyzes a
single cell and either copies the whole row to another sheet or skips
over it, based on its value. Here's the code:

Sub DefineBundles()=
Sheets("Spare Scroller Cables").Select
Range("A2").Select
Sheets("Scroller Info").Select
Range("F2").Select
Do Until ActiveCell = ""
If (ActiveCell.Value) >= 50 Then Application.Run "CreateSpare"
Loop
End Sub

Sub CreateSpare()
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Copy
Sheets("Spare Scroller Cables").Select
ActiveSheet.Paste
Selection.Offset(1, 0).Select
Sheets("Scroller Info").Select
Selection.Offset(1, 5).Select
' This is trying to counter-act the row/cell selection issue. It
didn't work.
End Sub

It seems like the problem is that when you return to the original
sheet, Excel doesn't like going back to looking at a cell when it has a
row selected. The offset- obviously- doesn't behave like the arrow
buttons would. I guess you could get around it by reselecting F2 and
doing a compounding offset, but there must be a less clunky way of
doing it.

Any advice is appreciated. Thanks,
Joe

 

[Tom Ogilvy]

Sub DefineBundles()
Dim cell as Range, rng as Range
Dim j as Long
With Sheets("Spare Scroller Cables")
set rng = .Range(.Range("A2"),Range("A2").End(xldown))
End With
j = 0
for each cell in rng
If Cell.Value >= 50 Then
CreateSpare cell, j
j = j + 1
endif
Next
End Sub

Sub CreateSpare(cell1 as Range, Offst as Long)
set DestRange = Worksheets("Scroller Info").Range("F2")
cell1.EntireRow.Copy Destination:=DestRange.Offset(Offst,-5)
End Sub

 

[Joe Fish]

Tom,
This is what I got:
Wrong number of arguments or invalid property assignment.

I would try to debug it, but I am new at this and frankly didn't
understand much of what you did.

Thanks, though.
Joe

 

[Tom Ogilvy]

I omitted a period in this statement:
Set rng = .Range(.Range("A2"), Range("A2").End(xlDown))

I changed it to

Set rng = .Range(.Range("A2"), .Range("A2").End(xlDown))

After fixing that, it ran fine for me and did exactly what **I** expected.

I also added a declaration for DestRange in CreateSpare in case you have
option explicit declared.

Sub DefineBundles()
Dim cell As Range, rng As Range
Dim j As Long
With Sheets("Spare Scroller Cables")
Set rng = .Range(.Range("A2"), .Range("A2").End(xlDown))
End With
j = 0
For Each cell In rng
If cell.Value >= 50 Then
CreateSpare cell, j
j = j + 1
End If
Next
End Sub

Sub CreateSpare(cell1 As Range, Offst As Long)
Dim DestRange As Range
Set DestRange = Worksheets("Scroller Info").Range("F2")
cell1.EntireRow.Copy Destination:=DestRange.Offset(Offst, -5)
End Sub

 

[Joe Fish]

I got the same message, and it highlighted (highlit?) the "CreateSpare"
before "cell, j"

I'm probably doing something wrong.

Thanks for the help,
Joe

 

[Tom Ogilvy]

Did you copy in my CreateSpare routine and remove yours? The error says
you probaby didn't. My CreateSpare requires two arguments to be passed to
it. Your CreateSpare doesn't.

As I said, it runs for me - no errors, performs as expected.

 

[Joe Fish]

Tom,
I figured out what I was doing wrong, I was changing the name of the
macro so it wouldn't conflict with the old one, but I forgot to change
the name of the internal run command. Ok, I fixed that, then I got the
sub to run, but it didn't do anything because the destination and
source ranges were reversed.
So I edited the ranges in the code, and then I got "Run Time Error
1004: Application-defined or object-defined error" and this was
highlighted:
cell1.EntireRow.Copy Destination:=DestRange.Offset(Offst, -5)

Here's what I did post-editing:

Sub DefineBundles()
Dim cell As Range, rng As Range
Dim j As Long
With Sheets("Scroller Info")
Set rng = .Range(.Range("A2"), .Range("F2").End(xlDown))
End With
j = 0
For Each cell In rng
If cell.Value >= 50 Then
CreateSpare cell, j
j = j + 1
End If
Next
End Sub

Sub CreateSpare(cell1 As Range, Offst As Long)
Dim DestRange As Range
Set DestRange = Worksheets("Spare Scroller Cables").Range("A2")
cell1.EntireRow.Copy Destination:=DestRange.Offset(Offst, -5)
End Sub


I have learned a ton with every go, thanks for the help, man.
Joe

 

[Tom Ogilvy]

If you want to look in column F of Scroller Info for your cells that are
greater than 50 and copy the row of any such cell to Spare Scroller Cables
starting in A2 and working down, then:

Sub DefineBundles()
Dim cell As Range, rng As Range
Dim j As Long
With Sheets("Scroller Info")
Set rng = .Range(.Range("F2"), .Range("F2").End(xlDown))
End With
j = 0
For Each cell In rng
If cell.Value >= 50 Then
CreateSpare cell, j
j = j + 1
End If
Next
End Sub

Sub CreateSpare(cell1 As Range, Offst As Long)
Dim DestRange As Range
Set DestRange = Worksheets("Spare Scroller Cables").Range("A2")
cell1.EntireRow.Copy Destination:=DestRange.Offset(Offst,0)
End Sub

 

[Joe Fish]

Oh my god, it works perfectly.
Now I get to spend all night figuring out how

Thanks, Tom. You're the best.
Joe