loop replacement of multiple if-then's

[dsi]

I have some very weird problems, i must be missing something easy but i
have been at it for some time...
the following code is where I can isolate the diffrent behaviours
I assume that uncommenting solution 1 should result in the same
behaviour as uncommenting Solution 2 (with more robustness) but
instead, Solution 1 results in Message section 1 not appearing, the
Msgtest appearing over and over (infinite loop) and Message3-5 not
appearing. If I use Solution 2 I get code that works and does exactly
what I need except it isn't scalable (ie only checks 4 times) and all
messages appear as expected.

<code>
For RowIndex = rowstart To rowend

Set c = Selection.Find()

'Message section 1:
Message = MsgBox(c.Value, vbInformation)
Message1 = MsgBox(Cells(c.Row, colPrimary).Value, vbInformation)
Message2 = MsgBox(Cells(c.Row, colPrimary).Value = "P",
vbInformation)


'Solution 1:
' Do Until (Cells(c.Row, colPrimary).Value = "P")
' Msgtest = MsgBox("testing", vbInformation)
' Set c = Cells(c.Row + 1, c.Column)
' Message3 = MsgBox(c.Value, vbInformation)
' Message4 = MsgBox(Cells(c.Row, colPrimary).Value,
vbInformation)
' Message5 = MsgBox(Cells(c.Row, colPrimary).Value = "P",
vbInformation)
' Loop

' Solution 2
' If (Cells(c.Row, colPrimary).Value <> "P") Then
' Set c = Cells(c.Row + 1, c.Column)
' Message3 = MsgBox(c.Value, vbInformation)
' Message4 = MsgBox(Cells(c.Row, colPrimary).Value,
vbInformation)
' Message5 = MsgBox(Cells(c.Row, colPrimary).Value = "P",
vbInformation)
' End If
' If (Cells(c.Row, colPrimary).Value <> "P") Then
' Set c = Cells(c.Row + 1, c.Column)
' Message3 = MsgBox(c.Value, vbInformation)
' Message4 = MsgBox(Cells(c.Row, colPrimary).Value,
vbInformation)
' Message5 = MsgBox(Cells(c.Row, colPrimary).Value = "P",
vbInformation)
' End If
' If (Cells(c.Row, colPrimary).Value <> "P") Then
' Set c = Cells(c.Row + 1, c.Column)
' Message3 = MsgBox(c.Value, vbInformation)
' Message4 = MsgBox(Cells(c.Row, colPrimary).Value,
vbInformation)
' Message5 = MsgBox(Cells(c.Row, colPrimary).Value = "P",
vbInformation)
' End If
' If (Cells(c.Row, colPrimary).Value <> "P") Then
' Set c = Cells(c.Row + 1, c.Column)
' Message3 = MsgBox(c.Value, vbInformation)
' Message4 = MsgBox(Cells(c.Row, colPrimary).Value,
vbInformation)
' Message5 = MsgBox(Cells(c.Row, colPrimary).Value = "P",
vbInformation)
' End If

Next RowIndex
</code>

 

[Bernie Deitrick]

You would be much better off describing what it is that you want to achieve: find all cells with P
in the current column.... etc.

HTH,
Bernie
MS Excel MVP

 

[dsi]

I was trying to simpify my question.
Basically I want to know:

1 - Why the MsgBox's stop working (even the ones before the infinite
loop).

2 - Why the do while...loop doesn't "drop in" to replace the 4 if then
statements.

 

[Bernie Deitrick]

The simple answer is (pick one)
- you aren't looping properly
- your logic is flawed
- your code is bad
- your workbook is poorly structured and the code doesn't interact with it
properly

But we can't test your code because you didn't explain the structure of the
workbook that it is working on, or any of its parameter. So we can't tell
you _why_ it's bad until you simply tell us what you want to do.

Bernie

 

[dsi]

I want to iterate throught the rows of a simple table, checking for the
value "P" in a specified column of each row, once I find "P" I want to
copy the row to a new workbook.

concatenating many (4) of the following together does exactly what I
need (except it won't handle the case of the engineers adding more than
5 similar parts)
If (Cells(c.Row, colPrimary).Value <> "P") Then
Set c = Cells(c.Row + 1, c.Column)
End If

The following do while...loop structure doesn't do what I need and
breaks MsgBox statements that appear before the loop in the code.
Do Until (Cells(c.Row, colPrimary).Value = "P")
Set c = Cells(c.Row + 1, c.Column)
Loop

do you need more info?

 

[Bernie Deitrick]

The simple answer is: Don't loop. Use Excel's built-in functionality to find the values in one
swoop, and copy them en-masse to a new workbook. This assumes that your simple data table is
contiguous (no entirely blank rows within the table).

_IF_ you wanted to move each one to a separate workbook, then post back, and we can modify the code
to loop through the found cells, adding a new workbook or worksheet for each.

Sub Macro1()
Dim mySht As Worksheet
Dim myRange As Range

' Change the line below to the sheet with your table, and a cell in the column with the P's
' There are lots of different ways to do this, but this is simple, for example purposes
Set myRange = Worksheets("Data").Range("D4")

Set mySht = Worksheets.Add
mySht.Name = "Extract"

With Intersect(myRange.EntireColumn, myRange.CurrentRegion)
.AutoFilter Field:=4 - .Cells(1).Column + 1, Criteria1:="P"
.SpecialCells(xlCellTypeVisible).EntireRow.Copy _
mySht.Range("1:1")
.AutoFilter
End With

mySht.Move

End Sub


HTH,
Bernie
MS Excel MVP

 

[dsi]

Thanks for the suggestion but I really wanted to know what is wrong
with _my_ code. It has become sort of philosophical, I have a working
"hack" and Excel is really not the solution to the task it is being
applied to, I just have an internal drive to understand what I did
wrong that makes the loop infinite. I thought it was something obvious
that I merely missed but appearently it is something deeper and I am
unwilling to delve into it (it being a bandaid solution in the
first-place). I do like to discover the reason behind unexpected
behaviour rather than merely "fix" it but this problem isn't really
time-effective to do that with.

Bernie, your suggestion did make me change the way I would approach
this problem in the future, thanks for working with me.

josh

 

[Bernie Deitrick]

josh,

I still don't understand what you expected the code to do: find the value P somewhere, and then do
what? Quit? Keep looking for other P's? To critique code requires a knowledge of what the code is
expected to do.

HTH,
Bernie
MS Excel MVP

 

[dsi]

the task break-down
- copy all primary "P" rows in currentlist from master list to a new
summary workbook

master list:
part# | primary flag
part1 | P
part1B |
part2 |
part2B |
part2C | P
part3 | P
part4 | P


current list:
part2
part4

the only part of the code that doesn't work is my old loop... (it also
causes some seemingly unrelated code to stop working ie.some MsgBoxes
before it in the code)

josh

 

[Bernie Deitrick]

Josh,

Why not

current list:
part1
part2C
part3
part4

Bernie
MS Excel MVP

 

[dsi]

Because they don't make lists that include alternatives... only the
master list has the alternatives, the current lists are subsets of the
master list and require the script to identify the primary part number
for that base part number