Help with Loop

J

Joe Fish

Hi,
I've tried coming at this a few ways, but I can't seem to make this run
the way I want. Ideally, each cell in the range is compared to the cell
above it. If it's the same, nothing happens. If it's different, the
Macro CreatePSPortLabel executes (which works fine).

What happens now is it runs the macro for every cell, and stops halfway
through the range.

Any ideas are welcome.
Thanks,
Fish

Dim cell As Range, 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
CreatePSPortLabel
End If
Next
 
N

Norman Jones

Hi Joe,

Try:

Public Sub Tester001()
Dim cell As Range, rng As Range
Dim LRow As Long

LRow = Cells(Rows.Count, "E").End(xlUp).Row

With Sheets("Scroller Info")
Set rng = .Range("E2:e" & LRow)
End With

For Each cell In rng
With cell
If .Value <> .Offset(-1).Value Then
CreatePSPortLabel
End If
End With
Next
End Sub
'<<=============
 
J

Jim Thomlinson

Do you have a blank cell in the range that you are trying to loop through.
xlDown will stop at the first blank cell which might be why you are having
the problem. Give this a whirl...

Dim cell As Range, rng As Range

With Sheets("Scroller Info")
Set rng = .Range(.Range("E2"), .Cells(rows.count, "E").end(xlUp))
End With

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

Joe Fish

Norman,
This does the same thing as mine. And by the way, there are no blank
cells in the range- and there wouldn't ever be.

It's so strange, because the loop just seems to stop for no reason.
 
N

Norman Jones

Hi Joe,
It's so strange, because the loop just seems to stop for no reason.

What do you mean by stop?

When I tested the code, I added the line:

Debug.print cell.Address

and was thus able to verify that the code processed all the requisite cells.
 
J

Joe Fish

When I say it stops, I mean it runs the internal macro for every cell
from Row 2 to Row 28, then it stops, meaning the active cell stops
advancing and the macro doesn't run from Row 29 through 88 (the end of
the column).
 
N

Norman Jones

Hi Joe,

The code, as written, makes no provision for selections and, consequently,
the active cell should not change when the code is run.

Are any of the E29:E88 cells populated?
 
N

Norman Jones

Hi Joe,

It might also clarify matters if you were to post the CreatePSPortLabel code
for consideration,
 
J

Joe Fish

Norman,
The active cell advance because of the internal macro. Here's all the
code:

Sub CreatePSPortLabels()

Application.DisplayAlerts = False
Sheets("PS Port Labels").Delete
Application.DisplayAlerts = True

CreatePSPortLabelsSheet
' This just creates the sheet where the info gets copied and pasted
to.
' It doesn't affect the loop.
MakeStagingArea
' This creates a sheet that stages the info to be copied and
pasted.
' It doesn't affect the loop.

Sheets("Scroller Info").Select
Range("E2").Select

Dim cell As Range, 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
CreatePSPortLabel
End If
Next

Application.DisplayAlerts = False
Sheets("Staging Area").Delete
Application.DisplayAlerts = True

End Sub

Sub CreatePSPortLabel()

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")

CopyAndPasteInformation

Sheets("Scroller Info").Select
ActiveCell.Offset(1, -4).Select

End Sub

Sub CopyAndPasteInformation()

Sheets("PS Port Labels").Select

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

ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=Stage3&Space&Stage4"
ActiveCell.Copy
ActiveCell.PasteSpecial Paste:=xlPasteValues

ActiveCell.Offset(1, -1).Select


End Sub
 
N

Norman Jones

Hi Joe,

If you wish to work on the active cell, then it would be necessary to
advance the selection in each loop pass, which is not what your code does.
The second sub advances the selection, but the second sub is only called
when the If...Then condition is satisfied. Consequently, when the condition
is not met, the second sub is not called and the active cell is not changed.

Additionally, it is unnecessary and inefficient to make selections in this
code.

Try, therefore, the following revision of the CreatePSPortLabels and the
dependent CreatePSPortLabel subs:

'=============>>
Sub CreatePSPortLabels()
Dim SH As Worksheet
Dim rCell As Range, rng As Range
Dim LRow As Long

Application.DisplayAlerts = False
Sheets("PS Port Labels").Delete
Application.DisplayAlerts = True

Call CreatePSPortLabelsSheet

Call MakeStagingArea

Set SH = Sheets("Scroller Info")

LRow = SH.Cells(Rows.Count, "E").End(xlUp).Row

Set rng = SH.Range("E2:E" & LRow)

For Each rCell In rng
With rCell
If .Value <> .Offset(-1).Value Then
Call CreatePSPortLabel(rCell)
End If
End With
Next

Application.DisplayAlerts = False
Sheets("Staging Area").Delete
Application.DisplayAlerts = True

End Sub

'--------------->>

Sub CreatePSPortLabel(aCell As Range)

With aCell
.Offset(0, -1).Copy Destination:=Range("Stage1")
.Copy Destination:=Range("Stage2")
.Offset(0, 3).Copy Destination:=Range("Stage3")
.Offset(0, 4).Copy Destination:=Range("Stage4")
End With

Call CopyAndPasteInformation

Sheets("Scroller Info").Select
End Sub
'<<=============
 
J

Joe Fish

Norman,
This works perfectly, and I see what I was doing wrong. Thanks for your
help, Norman.

Fish
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads


Top