Is Multi-Sequence Search Selection Macro Possible?

[Cecil]

Hi:

This is the first time I am posting to this newsgroup and if it is not the
right place for my question, please point me to the correct newsgroup.

If I have three columns with a multiple sequences of numbers, separated by
empty cells,
is it programmatically possible to have a macro to select a specific pattern
in the three columns that meet the following conditions:

For example using columns R, S and T.

In column S, find a vertical sequence of 1, 2, 3, 4 and 5, that is followed
by a vertical sequence of

1 through 13, directly to the left of column S, the next row down in column
R, followed by a vertical

sequence of 1, 2, 3, directly to the right of column R, the next row down in
column S, and finally

followed by a vertical sequence of 1 through 19, directly to the right of
column S, the next row down

in column T?

My goal is to have a macro to find the right sequence of 40 numbers while
ignoring sequences that don't

match. A nice bonus would be if no matches are found after the search
completes, to display a "Match not found", messagebox!

Any help would be appreciated!
Thanks in advance,
Cecil

 

[p45cal]

Yes, it is possible. But before I suggest a solution I'm a bit worrie
by > separated by empty cellsWhat is separated by empty cells? the sequences, or the individua
values, just one empty cell in each case, or several?
It would help if you could include an attachment (at codecage.com wher
I'm answering this) preferably with the sequence searched for present s
I can test

 

[Joel]

It would be best to post some lines of the data so we can see the pattern.
there are many was of searching through data like this and things that you
may not think are important may require different programming techniques. I
have done thousand of programs like this and each one has some unique
requirements. it is better to see samples of the data than a description. A
picture is worth a thousand words.

 

[c-town]

Hi:

This is the first time I am posting to this newsgroup and if it is no
the
right place for my question, please point me to the correct newsgroup.

If I have three columns with a multiple sequences of numbers, separate
by
empty cells,
is it programmatically possible to have a macro to select a specifi
pattern
in the three columns that meet the following conditions:

For example using columns R, S and T.

In column S, find a vertical sequence of 1, 2, 3, 4 and 5, that i
followed
by a vertical sequence of

1 through 13, directly to the left of column S, the next row down i
column
R, followed by a vertical

sequence of 1, 2, 3, directly to the right of column R, the next ro
down in
column S, and finally

followed by a vertical sequence of 1 through 19, directly to the righ
of
column S, the next row down

in column T?

My goal is to have a macro to find the right sequence of 40 number
while
ignoring sequences that don't

match. A nice bonus would be if no matches are found after the search
completes, to display a "Match not found", messagebox!

Any help would be appreciated!
Thanks in advance,
Cecil

Hi,

Thank you for your willingness to help me!
Sorry about my lack of clearity. As for the number of blank cells i
the columns of sequences,
the number of blank cells can vary speratically before consistan
sequences begin to develop.
I have included an example worksheet in a workbook to serve as a
example.

The columns of sequences in question in this worksheet are AE, AF an
AG.
I used columns R, S and T in my post to try and minimize the complexit
in explaining my problem.
You'll notice that ranges in columns AF1764:AF1768, AE1769:AE1781
AF1782:AF1784 and AG1785:AG1804
actually match the sequence I am seeking.
Hence the target sequence of 40 data points as follows;

1 thru 5 1 thru 13 1 thru 3 1 thru 19
AF1764:AF1768, AE1769:AE1781, AF1782:AF1784 and AG1785:AG1804

My final task will be to copy the relative columns of values fro
columns Y, Z and AA, into column AN2:AN41, or display a message bo
stating the "Sequence not Found" using the macro.
Therefore, the values in ranges Z1764:Z1768, Y1769:Y1781, Z1782:Z178
and AA1785:AA1804 respectively,
must be copied to range AN2:AN41 for export into other applications.

Thank you again for your help,
Ceci

+-------------------------------------------------------------------
|Filename: Multi-SequenceSelection.xls
|Download: http://www.thecodecage.com/forumz/attachment.php?attachmentid=219
+-------------------------------------------------------------------

 

[p45cal]

Run this macro (tested) with the appropriate sheet being the activ
sheet. It finds three such sequences:Sub blah()
'$B$1:$B$5,$A$6:$A$18,$B$19:$B$21,$C$22:$C$40 The shape of th
multi-area range to check.
AtLeastOneSequenceFound = False
With ActiveSheet
For Each cll In Intersect(.UsedRange, .Columns("AF"))
'On Error Resume Next '(uncomment if a #Value causes an error i
the next line)
If cll.Value = 1 And cll.Offset(1).Value = 2 Then 'a prelim searc
for candidates before checking deeper.
'cll.Offset(
-1).Range("$B$1:$B$5,$A$6:$A$18,$B$19:$B$21,$C$22:$C$40").Select
'ActiveWindow.ScrollRow = cll.Row - 1
'Stop
SequenceFailed = False
For Each myArea In cll.Offset(
-1).Range("$B$1:$B$5,$A$6:$A$18,$B$19:$B$21,$C$22:$C$40").Areas
'myArea.Select
For i = 1 To myArea.Cells.Count
'myArea.Cells(i).Select
If myArea.Cells(i).Value <> i Then
SequenceFailed = True
Exit For
End If
Next i
If SequenceFailed Then Exit For
Next myArea
If Not SequenceFailed Then
AtLeastOneSequenceFound = True
cll.Offset(
-1).Range("$B$1:$B$5,$A$6:$A$18,$B$19:$B$21,$C$22:$C$40").Select
ActiveWindow.ScrollRow = cll.Row - 1
MsgBox "Sequence found starting at " & cll.Address(False
False)
'Stop
'Code here will copy but awaiting what to copy (a) if more tha
one sequence found and
'(b) as there is no data in some of the cells to be copied
what to copy? Both a and b apply on this sheet.
End If
End If 'cll.Value = 1 And cll.Offset(1) = 2
'On Error GoTo 0' cancels On Error Resume Next
Next cll
End With 'activesheet
If Not AtLeastOneSequenceFound Then MsgBox "Sequence not found"
End Subbut note:
1. You said:"1 thru 5 1 thru 13 1 thru 3 1 thru 19" but you also sai
"AG1785:AG1804" was found for the last bit which is 1 thru *20*. Whic
is it? I've assumed 19 above.
2. You said:"the values in ranges Z1764:Z1768, Y1769:Y1781, Z1782:Z178
and AA1785:AA1804 respectively,must be copied". Some of these cells ar
blank, viz. AA1785 and AA1786. Surely not your intention.
3. What to do when a second and subsequent sequence is found? (Yo
won't want to be copying values to AN2:AN41 again.

 

[c-town]

Run this macro (tested) with the appropriate sheet being the active
sheet. It finds three such sequences:Sub blah()
'$B$1:$B$5,$A$6:$A$18,$B$19:$B$21,$C$22:$C$40 The shape of the
multi-area range to check.
AtLeastOneSequenceFound = False
With ActiveSheet
For Each cll In Intersect(.UsedRange, .Columns("AF"))
'On Error Resume Next '(uncomment if a #Value causes an error in
the next line)
If cll.Value = 1 And cll.Offset(1).Value = 2 Then 'a prelim search
for candidates before checking deeper.
'cll.Offset(,
-1).Range("$B$1:$B$5,$A$6:$A$18,$B$19:$B$21,$C$22:$C$40").Select
'ActiveWindow.ScrollRow = cll.Row - 1
'Stop
SequenceFailed = False
For Each myArea In cll.Offset(,
-1).Range("$B$1:$B$5,$A$6:$A$18,$B$19:$B$21,$C$22:$C$40").Areas
'myArea.Select
For i = 1 To myArea.Cells.Count
'myArea.Cells(i).Select
If myArea.Cells(i).Value <> i Then
SequenceFailed = True
Exit For
End If
Next i
If SequenceFailed Then Exit For
Next myArea
If Not SequenceFailed Then
AtLeastOneSequenceFound = True
cll.Offset(,
-1).Range("$B$1:$B$5,$A$6:$A$18,$B$19:$B$21,$C$22:$C$40").Select
ActiveWindow.ScrollRow = cll.Row - 1
MsgBox "Sequence found starting at " & cll.Address(False,
False)
'Stop
'Code here will copy but awaiting what to copy (a) if more than
one sequence found and
'(b) as there is no data in some of the cells to be copied,
what to copy? Both a and b apply on this sheet.
End If
End If 'cll.Value = 1 And cll.Offset(1) = 2
'On Error GoTo 0' cancels On Error Resume Next
Next cll
End With 'activesheet
If Not AtLeastOneSequenceFound Then MsgBox "Sequence not found"
End Subbut note:
1. You said:"1 thru 5 1 thru 13 1 thru 3 1 thru 19" but you also said
"AG1785:AG1804" was found for the last bit which is 1 thru *20*. Which
is it? I've assumed 19 above.
2. You said:"the values in ranges Z1764:Z1768, Y1769:Y1781, Z1782:Z1784
and AA1785:AA1804 respectively,must be copied". Some of these cells are
blank, viz. AA1785 and AA1786. Surely not your intention.
3. What to do when a second and subsequent sequence is found? (You
won't want to be copying values to AN2:AN41 again.)
4. There are a bunch of commented-out lines in the code which I used to
help me develop/debug so try reinstating some and when the code stops,
step through with the F8 and F5 keys.

Hi p45cal,

You are correct about the 1 thru 19 sequence, rather than 1 thru 20.
The total number of cells in the combined sequences targeted should
only be 40.

Your comment, > “2. You said:"the values in ranges Z1764:Z1768, Y1769:Y1781, Z1782:Z1784

and AA1785:AA1804 respectively,must be copied". Some of these cells are
blank, viz. AA1785 and AA1786. Surely not your intention”. Is also correct, if possible via code, I would like to have the search

continue on to the group of sequences that do not have such flaws, but
with the intent of capturing the first correct sequence found.

While reading through your code I couldn’t help but notice your use of
cell “c11". Please tell me a bit of it’s function in case I need to
adjust it’s address or target value for my worksheet?
I’ve created the module with your code, and adjusted the column
addresses to match my worksheet, but I am a bit vague on the function of
cell “c11”.

Thank you so much, for your help thus far. And I really appreciate your
time.
Cecil,

 

[p45cal]

*1.*> Speaking of flaws, that portion of the sequence should not have passe

as a numerically consecutive set of values.

Why not? Is it something we should code to avoid? What defines it a
failing?


*2.* You didn't address Q3 (What to do when a second and subsequen
sequence is found? (You won't want to be copying values to AN2:AN4
again.))


*3.*> While reading through your code I couldn’t help but notice your use o

cell “c11". Please tell me a bit of it’s function

Careful here, it's not “c11", but "cll" (to use capitals:it's not "C11
but "CLL"). It's a range object which I chose to name 'cll' and refer
to a single cell, set in the line:For Each cll I
Intersect(.UsedRange, .Columns("AF"))which, if I was bein
explicit in the code, could have read:For Each cll I
Intersect(.UsedRange, .Columns("AF")).CellsIt's just a wa
of running down each cell in column AF. If you had just this code in
sub and stepped through it with F8:For Each cll I
Intersect(.UsedRange, .Columns("AF")).Cells
cll.Select
Next cll
you could watch it select each cell in turn, starting a
the top

 

[c-town]

1.
Why not? Is it something we should code to avoid? What defines it as
failing?


2.[/B] YOU DIDN'T ADDRESS Q3 (WHAT TO DO WHEN A SECOND AND SUBSEQUENT
SEQUENCE IS FOUND? (YOU WON'T WANT TO BE COPYING VALUES TO AN2:AN41
AGAIN.))


3.
Careful here, it's not “c11", but "cll" (to use capitals:it's not "C11"
but "CLL"). It's a range object which I chose to name 'cll' and refers
to a single cell, set in the line:For Each cll In
Intersect(.UsedRange, .Columns("AF"))which, if I was being
explicit in the code, could have read:For Each cll In
Intersect(.UsedRange, .Columns("AF")).CellsIt's just a way
of running down each cell in column AF. If you had just this code in a
sub and stepped through it with F8:For Each cll In
Intersect(.UsedRange, .Columns("AF")).Cells
cll.Select
Next cll
you could watch it select each cell in turn, starting at
the top.

ps. it might be a good idea to attach your amended workbook if you want
me to add code

Hi p45cal,

I want to respond to your recent questions and add a few update
comments.

but note:
Q1. You said:"1 thru 5 1 thru 13 1 thru 3 1 thru 19" but you also said
"AG1785:AG1804" was found for the last bit which is 1 thru 20. Which is
it? I've assumed 19 above.

A1) You are correct about the 1 thru 19 sequence, rather than 1 thru
20.
The total number of cells in the combined sequences targeted should
only be 40.

Your comment,

“Q2. You said:"the values in ranges Z1764:Z1768, Y1769:Y1781,
Z1782:Z1784 and AA1785:AA1804 respectively,must be copied". Some of
these cells are blank, viz. AA1785 and AA1786. Surely not your
intention”.

A2) Is also correct, if possible via code, I would like to have the
search continue on to the group of sequences that do not have such
flaws, but with the intent of capturing the first correct group of
sequences found.
Speaking of flaws, that portion of the sequence should not have passed
as a numerically consecutive set of values based on my column formulas.


With respect to question #2, I realize now that I must have a final
test in the macro for it to be completed successfully. Because the goal
of generating this sequence of "1 thru 5, 1 thru 13, 1 thru 3, 1 thru
19", is to locate, and confirm that a specific set of values exist, and
meet a flow of continuous values in 40 points of data that create the
sequence form.

Q3. What to do when a second and subsequent sequence is found? (You
won't want to be copying values to AN2:AN41 again.)

A3) Briefly put, the job of the formulas in columns AE, AF and AG, is
to monitor values six columns to the left in parallel cells of columns
Y, Z and AA. In turn, the rudimentary sequence of numbers are generated
revealing the target form from the data stream.
Therefore, once the correct sequence is located in columns AE, AF and
AG, a final test would be that the copy process should only succeed if
values truly exist in the cells being copied. So, once a match is found,
then what is needed is to test the authenticity of cell values and
perform the copy process and stop the search.

The position of where each sequence begins and ends in relation to
one-another, is critical to the overall function and results of the
worksheet. More specifically, the form that is created by the target
combination of sequences is most critical. Values in a cell that are
extended after, or next to the form of the target combination of
sequences should be ignored by the macro.

I have since adjusted the formulas in “AG and AA” columns to correct
the oversight that allowed blank cells to be represented as having
useable values, thanks to your attention to details.

I greatly appreciate how far we have gotten already with your help!
Although, currently the macro is searching the wrong columns, “BI, BJ
and BK”.
But I have been unable to decipher where in the code, the start point
for the search is being set. So I have been unable to adjust it.
So I am including my current version of the worksheet, in hopes that
you can correct it.
Other than that, I have the full macro commands active with no program
errors or error trapping commands active, just the Message Box stating
"Sequence not found" and displaying the active cell address when the
macro ends.

Thanks again p45cal, for any help you may offer!
Cecil


+-------------------------------------------------------------------+
|Filename: Multi-SequenceSelection.xls |
|Download: http://www.thecodecage.com/forumz/attachment.php?attachmentid=232|
+-------------------------------------------------------------------+

 

[p45cal]

The code below (and the attached) now also check for the presence o
values in the cells offset 6 to the left while searching for sequences.
It writes the results to AN2:AN41, but since you still haven't told m
what to do with multiple finds I've put a temporary msgbox line in t
warn you that it's about to overwrite those cells, until you decide ho
to handle them.Sub SeqFind()
Dim Sequence(39) 'array to hold values when a sequence is found
TheShape = "$B$1:$B$5,$A$6:$A$18,$B$19:$B$21,$C$22:$C$40" ' The shap
of the multi-area range to check.
AtLeastOneSequenceFound = False
With ActiveSheet
For Each cll In Intersect(.UsedRange, .Columns("AF"))
'On Error Resume Next '(uncomment if a #Value causes an error i
the next line)
If cll.Value = 1 And cll.Offset(1).Value = 2 Then 'a prelim searc
for candidates before checking deeper.
'cll.Offset(, -1).Range(TheShape).Select
'ActiveWindow.ScrollRow = cll.Row - 1
'Stop
SequenceFailed = False
For Each myArea In cll.Offset(, -1).Range(TheShape).Areas
'myArea.Select
For i = 1 To myArea.Cells.Count
'myArea.Cells(i).Select
If myArea.Cells(i).Value <> i Or myArea.Cells(i).Offset(, -6
= "" Then
SequenceFailed = True
Exit For
End If
Next i
If SequenceFailed Then Exit For
Next myArea
If Not SequenceFailed Then
AtLeastOneSequenceFound = True
cll.Offset(, -1).Range(TheShape).Select
ActiveWindow.ScrollRow = cll.Row - 1
MsgBox "Sequence found starting at " & cll.Address(False
False)
'Stop
Erase Sequence 'empties the array of any previously foun
values (shouldn't be necessary)
i = 0
For Each myCell In cll.Offset(, -1).Range(TheShape).Offset(
-6).Cells
Sequence(i) = myCell.Value
i = i + 1
Next myCell
MsgBox "about to overwrite cells AN2:AN41 with new values"
.Range("AN2:AN41") = Application.Transpose(Sequence)
End If 'Not SequenceFailed
End If 'cll.Value = 1 And cll.Offset(1) = 2
'On Error GoTo 0' cancels On Error Resume Next
Next cll
End With 'activesheet
If Not AtLeastOneSequenceFound Then MsgBox "Sequence not found" ' _
' & Chr(13) & " Search Process Ending" & Chr(13) _
' & " The current active cell is " & ActiveCell.Address
'Range("AF2").Activate
End Su

+-------------------------------------------------------------------
|Filename: Multi-SequenceSelection02.xls
|Download: http://www.thecodecage.com/forumz/attachment.php?attachmentid=233
+-------------------------------------------------------------------

 

[c-town]

The code below (and the attached) now also check for the presence o
values in the cells offset 6 to the left while searching for sequences.
It writes the results to AN2:AN41, but since you still haven't told m
what to do with multiple finds I've put a temporary msgbox line in t
warn you that it's about to overwrite those cells, until you decide ho
to handle them.Sub SeqFind()
Dim Sequence(39) 'array to hold values when a sequence is found
TheShape = "$B$1:$B$5,$A$6:$A$18,$B$19:$B$21,$C$22:$C$40" ' The shap
of the multi-area range to check.
AtLeastOneSequenceFound = False
With ActiveSheet
For Each cll In Intersect(.UsedRange, .Columns("AF"))
'On Error Resume Next '(uncomment if a #Value causes an error i
the next line)
If cll.Value = 1 And cll.Offset(1).Value = 2 Then 'a prelim searc
for candidates before checking deeper.
'cll.Offset(, -1).Range(TheShape).Select
'ActiveWindow.ScrollRow = cll.Row - 1
'Stop
SequenceFailed = False
For Each myArea In cll.Offset(, -1).Range(TheShape).Areas
'myArea.Select
For i = 1 To myArea.Cells.Count
'myArea.Cells(i).Select
If myArea.Cells(i).Value <> i Or myArea.Cells(i).Offset(, -6
= "" Then
SequenceFailed = True
Exit For
End If
Next i
If SequenceFailed Then Exit For
Next myArea
If Not SequenceFailed Then
AtLeastOneSequenceFound = True
cll.Offset(, -1).Range(TheShape).Select
ActiveWindow.ScrollRow = cll.Row - 1
MsgBox "Sequence found starting at " & cll.Address(False
False)
'Stop
Erase Sequence 'empties the array of any previously foun
values (shouldn't be necessary)
i = 0
For Each myCell In cll.Offset(, -1).Range(TheShape).Offset(
-6).Cells
Sequence(i) = myCell.Value
i = i + 1
Next myCell
MsgBox "about to overwrite cells AN2:AN41 with new values"
.Range("AN2:AN41") = Application.Transpose(Sequence)
End If 'Not SequenceFailed
End If 'cll.Value = 1 And cll.Offset(1) = 2
'On Error GoTo 0' cancels On Error Resume Next
Next cll
End With 'activesheet
If Not AtLeastOneSequenceFound Then MsgBox "Sequence not found" ' _
' & Chr(13) & " Search Process Ending" & Chr(13) _
' & " The current active cell is " & ActiveCell.Address
'Range("AF2").Activate
End Sub

Hi p45cal,

In answer to your question;

Q) It writes the results to AN2:AN41, but since you still haven't tol
me
what to do with multiple finds I've put a temporary msgbox line in to
warn you that it's about to overwrite those cells, until you decid
how
to handle them.

A) I’ve given that question much thought, and I believe the wis
approach would be to make use of the message box at that moment, b
having it offer the choice of copying the current form results and abor
farther searching, or skip copying the current form results and procee
to search for any additional form sequences. But in doing so, simply us
the currently located form start address as a locator, to hi-light th
current form sequence before continuing the search for another match.

Preferably, the hi-light color of choice would be the same one
saw in the earlier trails that you used to reveal the shape of the tes
form on empty cells. The reason I suggest this approach is because i
would allow me to know how many matches are available after havin
searched the full length of the columns, and possibly to save eac
sequence start address down column AQ2, AQ3, AQ4 and so on, a
hyperlinks so each match can be visually compared and examined for th
tightest conformance values before choosing to copy a specific sequenc
result. That way I could merely re-run the macro and know the bes
choice to make. This is what I actually hope to achieve from this task

But for what you have helped me with already I am very grateful, and
really admire how efficient your code is working out.

I would also appreciate your opinion about the possibility of what
have suggested to complete this macro and if it would have a negativ
affect on the conditional formatting I’m already using in columns AE, A
and AG? And, would you advise leaving the “Option Explicit” command
commented out? From what I learned thus far I would need to “Dim” every
variable to apply the command successful, and negate future errors!

Thank you so much p45cal,
Cecil

 

[p45cal]

The code below
1.Adds a grey colour to the found sequence. (Previously, no highlight
was applied to the found cells except to select them - the highlight you
saw was just selected cells.) The code does not remove the highlighting.
The conditional formatting is not affected because the CF doesn't alter
the colour of the cell.

2.Asks if you want to transfer the found sequence.
The idea behind this that is on the first run of the macro you say *No
*each time (*No *is the default button), so you can keep pressing the
*Enter *key (or the *N *key) each time the question is asked. When it
finishes it will tell you how many sequences were found.
Now you run the macro a second time and answer *Yes *(with a click or
with the keyboard *Y*) on the one you want transferred. The first time
you answer *Yes*, the transfer takes place and the rest of the search is
aborted.

3.Declares all variables etc. It's better practice to have *Option
Explicit* - it spots variable/object spelling mistakes for you, though
at the start of development I rarely use it.

Suggestions for finishing off:
Your main problem will be deciding which of the sequences found is the
best to use. I note that there are charts on the sheet. It would involve
some coding, but you could have the currently-found sequence plotted on
a temporary chart (or better perhaps, a temporary line on an existing
chart) to help you assess conformance and make a good
choice.Sub SeqFind()
Dim TheShape As String, cll As Range, myArea As Range,
YouWantToOverwrite
Dim SequencesFoundCount As Long, i As Long, SequenceFailed As Boolean
Dim myCell As Range
Dim Sequence(39) 'array to hold values when a sequence is found
TheShape = "$B$1:$B$5,$A$6:$A$18,$B$19:$B$21,$C$22:$C$40" ' The shape
of the multi-area range to check.
SequencesFoundCount = 0
With ActiveSheet
For Each cll In Intersect(.UsedRange, .Columns("AF"))
'On Error Resume Next '(uncomment if a #Value causes an error in
the next line)
If cll.Value = 1 And cll.Offset(1).Value = 2 Then 'a prelim search
for candidates before checking deeper.
SequenceFailed = False
For Each myArea In cll.Offset(, -1).Range(TheShape).Areas
For i = 1 To myArea.Cells.Count
If myArea.Cells(i).Value <> i Or myArea.Cells(i).Offset(, -6)
= "" Then
SequenceFailed = True
Exit For
End If
Next i
If SequenceFailed Then Exit For
Next myArea
If Not SequenceFailed Then
SequencesFoundCount = SequencesFoundCount + 1
cll.Offset(, -1).Range(TheShape).Interior.ColorIndex = 15
'light grey
ActiveWindow.ScrollRow = cll.Row - 1
YouWantToOverwrite = MsgBox("Sequence no. " &
SequencesFoundCount & " found starting at" & Replace(cll.Address, "$", "
") & vbLf & vbLf & "Overwrite cells AN2:AN41 with new values?", vbYesNo
+ vbDefaultButton2, "Overwrite?")
If YouWantToOverwrite = vbYes Then
Erase Sequence 'empties the array of any previously found
values (shouldn't be necessary)
i = 0
For Each myCell In cll.Offset(, -1).Range(TheShape).Offset(,
-6).Cells
Sequence(i) = myCell.Value
i = i + 1
Next myCell
Range("AN2:AN41") = Application.Transpose(Sequence)
MsgBox "Sequence no. " & SequencesFoundCount & " transferred,
abandoning rest of search."
Exit Sub
End If
End If 'Not SequenceFailed
End If 'cll.Value = 1 And cll.Offset(1) = 2
'On Error GoTo 0' cancels On Error Resume Next
Next cll
End With 'activesheet
If SequencesFoundCount = 0 Then
MsgBox "Sequence not found"
Else
MsgBox "A total of " & SequencesFoundCount & " sequence(s) found on
this sheet."
End If 'SequencesFoundCount = 0
End Sub

 

[c-town]

The code below
1.Adds a grey colour to the found sequence. (Previously, no highligh
was applied to the found cells except to select them - the highlight yo
saw was just selected cells.) The code does not remove the highlighting
The conditional formatting is not affected because the CF doesn't alte
the colour of the cell.

2.Asks if you want to transfer the found sequence.
The idea behind this that is on the first run of the macro you say *N
*each time (*No *is the default button), so you can keep pressing th
*Enter *key (or the *N *key) each time the question is asked. When i
finishes it will tell you how many sequences were found.
Now you run the macro a second time and answer *Yes *(with a click o
with the keyboard *Y*) on the one you want transferred. The first tim
you answer *Yes*, the transfer takes place and the rest of the search i
aborted.

3.Declares all variables etc. It's better practice to have *Optio
Explicit* - it spots variable/object spelling mistakes for you, thoug
at the start of development I rarely use it.

Suggestions for finishing off:
Your main problem will be deciding which of the sequences found is th
best to use. I note that there are charts on the sheet. It would involv
some coding, but you could have the currently-found sequence plotted o
a temporary chart (or better perhaps, a temporary line on an existin
chart) to help you assess conformance and make a goo
choice.Sub SeqFind()
Dim TheShape As String, cll As Range, myArea As Range
YouWantToOverwrite
Dim SequencesFoundCount As Long, i As Long, SequenceFailed As Boolean
Dim myCell As Range
Dim Sequence(39) 'array to hold values when a sequence is found
TheShape = "$B$1:$B$5,$A$6:$A$18,$B$19:$B$21,$C$22:$C$40" ' The shap
of the multi-area range to check.
SequencesFoundCount = 0
With ActiveSheet
For Each cll In Intersect(.UsedRange, .Columns("AF"))
'On Error Resume Next '(uncomment if a #Value causes an error i
the next line)
If cll.Value = 1 And cll.Offset(1).Value = 2 Then 'a prelim searc
for candidates before checking deeper.
SequenceFailed = False
For Each myArea In cll.Offset(, -1).Range(TheShape).Areas
For i = 1 To myArea.Cells.Count
If myArea.Cells(i).Value <> i Or myArea.Cells(i).Offset(, -6
= "" Then
SequenceFailed = True
Exit For
End If
Next i
If SequenceFailed Then Exit For
Next myArea
If Not SequenceFailed Then
SequencesFoundCount = SequencesFoundCount + 1
cll.Offset(, -1).Range(TheShape).Interior.ColorIndex = 15
'light grey
ActiveWindow.ScrollRow = cll.Row - 1
YouWantToOverwrite = MsgBox("Sequence no. "
SequencesFoundCount & " found starting at" & Replace(cll.Address, "$",
") & vbLf & vbLf & "Overwrite cells AN2:AN41 with new values?", vbYesN
+ vbDefaultButton2, "Overwrite?")
If YouWantToOverwrite = vbYes Then
Erase Sequence 'empties the array of any previously foun
values (shouldn't be necessary)
i = 0
For Each myCell In cll.Offset(, -1).Range(TheShape).Offset(
-6).Cells
Sequence(i) = myCell.Value
i = i + 1
Next myCell
.Range("AN2:AN41") = Application.Transpose(Sequence)
MsgBox "Sequence no. " & SequencesFoundCount & " transferred
abandoning rest of search."
Exit Sub
End If
End If 'Not SequenceFailed
End If 'cll.Value = 1 And cll.Offset(1) = 2
'On Error GoTo 0' cancels On Error Resume Next
Next cll
End With 'activesheet
If SequencesFoundCount = 0 Then
MsgBox "Sequence not found"
Else
MsgBox "A total of " & SequencesFoundCount & " sequence(s) found o
this sheet."
End If 'SequencesFoundCount = 0
End Sub

Hi p45cal,

I thought you might like to know that the macro is working very well!
I have added the chart per your suggestion in your last reply. A ver
clever solution for visual comparison!

The chart currently uses the 40 points of data that were copied t
column Range("AN2:AN41") after the final run of the macro, to presen
the shape of the curve in the chart. I have also created a second macr
that now loads the next test stream of data, clears the values in
Range("AN2:AN41") and removes hi-lighted colors in columns "AE, AF and
AG" to avoid confusion when new forms are located. In addition, I've
added buttons on the worksheet to trigger either macro.

I wonder if you know of a way I can have the message box offer an
option to copy each of the forms located in the first past, into
consecutive columns next to the right of Range("AN2:AN41"), so I can
include them in my chart for visual comparison? I plan to assign them
each a different color in the same chart.

Preparing the chart to display the copied forms will not be an issue
for me, but getting the hi-lighted results side-by-side using the shapes
already found, without messing up your good work, that's what I want to
avoid.
If you are willing to help me with this critical step, I would really
appreciate it!

Thank you for everything done already p45cal,
Cecil

 

[p45cal]

I've taken a short cut; not changed the message, but changed what
happens when you say No. It puts the values in the cells directly to the
right of AN2:AN41, pushing anything there to the right too. It labels
the column with the sequence no. and the address of the top of the found
sequence.Sub SeqFind()
Dim TheShape As String, cll As Range, myArea As Range,
YouWantToOverwrite
Dim SequencesFoundCount As Long, i As Long, SequenceFailed As Boolean
Dim myCell As Range
Dim Sequence(39) 'array to hold values when a sequence is found
TheShape = "$B$1:$B$5,$A$6:$A$18,$B$19:$B$21,$C$22:$C$40" ' The shape
of the multi-area range to check.
SequencesFoundCount = 0
With ActiveSheet
For Each cll In Intersect(.UsedRange, .Columns("AF"))
'On Error Resume Next '(uncomment if a #Value causes an error in
the next line)
If cll.Value = 1 And cll.Offset(1).Value = 2 Then 'a prelim search
for candidates before checking deeper.
SequenceFailed = False
For Each myArea In cll.Offset(, -1).Range(TheShape).Areas
For i = 1 To myArea.Cells.Count
If myArea.Cells(i).Value <> i Or myArea.Cells(i).Offset(, -6)
= "" Then
SequenceFailed = True
Exit For
End If
Next i
If SequenceFailed Then Exit For
Next myArea
If Not SequenceFailed Then
SequencesFoundCount = SequencesFoundCount + 1
cll.Offset(, -1).Range(TheShape).Interior.ColorIndex = 15
'light grey
ActiveWindow.ScrollRow = cll.Row - 1
Erase Sequence 'empties the array of any previously found
values (shouldn't be necessary)
i = 0
For Each myCell In cll.Offset(, -1).Range(TheShape).Offset(,
-6).Cells
Sequence(i) = myCell.Value
i = i + 1
Next myCell
YouWantToOverwrite = MsgBox("Sequence no. " &
SequencesFoundCount & " found starting at" & Replace(cll.Address, "$", "
") & vbLf & vbLf & "Overwrite cells AN2:AN41 with new values?", vbYesNo
+ vbDefaultButton2, "Overwrite?")
If YouWantToOverwrite = vbYes Then
Range("AN2:AN41") = Application.Transpose(Sequence)
MsgBox "Sequence no. " & SequencesFoundCount & " transferred,
abandoning rest of search."
Exit Sub
Else 'copy to right
Range("AO1:AO41").Insert Shift:=xlToRight
Range("AO1").Value = SequencesFoundCount & vbLf & "(" &
Replace(cll.Address, "$", " ") & ")"
Range("AO2:AO41") = Application.Transpose(Sequence)
End If
End If 'Not SequenceFailed
End If 'cll.Value = 1 And cll.Offset(1) = 2
'On Error GoTo 0' cancels On Error Resume Next
Next cll
End With 'activesheet
If SequencesFoundCount = 0 Then
MsgBox "Sequence not found"
Else
MsgBox "A total of " & SequencesFoundCount & " sequence(s) found on
this sheet."
End If 'SequencesFoundCount = 0
End Sub