For Each not workig correctly

[Joe Fish]

Hi,
In the following block of code, theoretically, each cell in a range
gets compared to one above it. If it matches, nothing happens. If it is
different, the macro CreatePSFrontLabel runs. What actually happens,
though, is the macro runs for the first six cells in the range (no
matter how it compares to the cell above it) and then stops.
Thanks in advance,
Joe


Sub MOO()

Dim rng As Range
With Sheets("Scroller Info")
Set rng = .Range(.Range("E2"), .Range("E2").End(xlDown))
End With

For Each cell In rng
If cell.Value <> cell.Offset(-1).Value Then
CreatePSFrontLabel
End If
Next

 

[Gary''s Student]

Hi Joe:

A debugging suggestion:

After the End With:

msgbox(rng.address)

Just to make sure that the range setting is what you expect.

 

[Joe Fish]

GS,
That's way cool, thanks for the tip. Unfortunately, the range is
correct, it's just not going all the way through the range.
Thanks,
Joe

 

[JE McGimpsey]

Does CreatePSFrontLabel change the values in rng?

Have you verified that rng is set correctly? Have you verified that the
macro stops before it loops the appropriate number of times - that would
be very odd.

 

[Joe Fish]

<Does CreatePSFrontLabel change the values in rng?>
No, but it moves the ActiveCell around looking for values to copy and
paste elsewhere.

<Have you verified that rng is set correctly? >
I verified it with msgbox(rng.address), and it was correct.

<Have you verified that the
macro stops before it loops the appropriate number of times - that
would
be very odd. >
I don't know for a fact that the macro loops correctly, but it runs the
internal macro for the first six cells and then seems to stop. Here is
the internal macro:

Sub CreatePSFrontLabel()

ActiveCell.Offset(0, -1).Select
ActiveCell.Copy Range("Stage1")
ActiveCell.Offset(0, 1).Select
ActiveCell.Copy Range("Stage2")
ActiveCell.Offset(0, 3).Select
ActiveCell.Copy Range("Stage3")
ActiveCell.Offset(0, 1).Select
ActiveCell.Copy Range("Stage4")

ActiveCell.Offset(1, -4).Select

Sheets("PS Front Labels").Select

ActiveCell.FormulaR1C1 = "=Stage1&Space&Stage2"
ActiveCell.Copy
ActiveCell.PasteSpecial Paste:=xlPasteValues

ActiveCell.Offset(1, 0).Select

ActiveCell.FormulaR1C1 = "=Stage3&Space&Stage4"
ActiveCell.Copy
ActiveCell.PasteSpecial Paste:=xlPasteValues

ActiveCell.Offset(1, 0).Select

Sheets("Scroller Info").Select

End Sub


Thanks,
Joe

 

[Leith Ross]

Hello Joe,

When using Range("E2").End(xlDown) it will stop when it encounters an
empty row. If your loop only executes 6 times (E2 to E7) and the range
is greater than E7, then I strongly suspect this is the problem. It is
a better practice to start at the bottom of the worksheet and move up
to find the end of an unknown range, just for this reason. The code
below contains the changes using this method.


Sub MOO()
Dim RC
Dim LastCell
Dim rng As Range
With Sheets("Scroller Info")
RC = .Rows.Count
LastCell = .Range("E" & RC).End(xlUp).Address
Set rng = .Range(.Range("E2"), .Range(LastCell))
End With

For Each cell In rng
If cell.Value <> cell.Offset(-1, 0).Value Then
CreatePSFrontLabel
End If
Next


Sincerely,
Leith Ross

 

[Joe Fish]

Leith,
Thanks for the idea, but there are no empty cells in the range, and
there never would be in this particular application.
Thanks,
Fish

 

[Gary Keramidas]

this seems to work for me, i just used message boxes because i don't know
what code you're trying to run. if this works for you, it's something in the
routine that's running if it matches

Sub MOO()

Dim rng As Range
With Sheets("Scroller Info")
Set rng = .Range(.Range("E2"), .Range("e2").End(xlDown))
Debug.Print rng.Address


For Each cell In rng
If cell.Value <> cell.Offset(-1).Value Then
MsgBox "CreatePSFrontLabel"

Else
MsgBox "match " & cell.Offset(-1, 0).Address & " " & cell.Address
End If

Next
End With
End Sub