Identify and number Patterns

larbec · Dec 7th 2013

Re: Identify and number Patterns

pike and Holycow

i don't know how to THANK YOU enough. I was already amazed at the speed it finds the liked pattern numbers but your patience with me and knowledge of all this is remarkable I will DL the updated file in about an hour when I have access to my laptop and check it out

pike

is this how I would copy and paste my counters (all 400,000+) without holding the left mouse button down fir 3 days lol?

"To highlight the full data set go to cell F12, hold down CTRL and SHIFT, press the down arrow, then, still holding down CTRL+SHIFT, press the left arrow."

holycow · Dec 7th 2013

Re: Identify and number Patterns

Hi larbec

shift+Ctrl+down arrow is the way to go but only if no empty cells in Column A. The data set I had to work with had blanks in Column A. Therefore I had to select A12:F12, press tab once to make active cell in Column B, then shift+ctrl+down arrow. But come to think of it, you should be able to click on any of the cells in the big list and press shift+Ctrl+* (the one on number 8 key, not the keypad).

hope all goes well and let us know any problems.

I have been ages typing this reply so sorry if someone else has replied in the meantime.

holycow · Dec 7th 2013

Re: Identify and number Patterns

Just had a thought shift+ctrl+* selects whole contiguous range, may not be ideal in the source you will be copying from.

holycow · Dec 7th 2013

Re: Identify and number Patterns

Quote from KjBox;694346

Presently there are cells formatted as general, number and I am sure I even saw a text format in there somewhere. Format all to 'Number' with 0 decimal places. At the same time you could set all cells to the same font type and size and bold or regular, there is a mixture of all of those currently.

Kjbox I love that attention to detail

**pike** · Dec 7th 2013

Re: Identify and number Patterns

Hi
Select the first cell to copy and c+s+end key

**KjBox** · Dec 7th 2013

Re: Identify and number Patterns

Quote

shift+Ctrl+down arrow is the way to go but only if no empty cells in Column A. The data set I had to work with had blanks in Column A.

That is why I said to start in Column F then down and left.

You could also just highlight A12:F12 then press Ctrl+shift+down arrow

snb · Dec 10th 2013

Re: Identify and number Patterns

Thanks to KjBox I was able to test my suggestion in ca. 350 000 rows.
It appeard the arrayfiltering method I had introduced doesn't like that amount of data.
I created an alternative based on the use of arrays.
That means that all calculations/comparisons are being made in memory and no formulae are needed in the worksheet.
Only when the result has to be be written to a sheet, interaction with the workbook takes place.

Code

Sub M_snb()
    Sheet2.Columns("L:Q").Clear
    c00 = [B2&C2&D2&E2&B3&C3&D3&E3&B4&C4&D4&E4&B5&C5&D5&E5&B6&C6&D6&E6&B7&C7&D7&E7&B8&C8&D8&E8&B9&C9&D9&E9]
    ReDim st(1 To 28, 1 To 6)
    
    sn = Sheet1.Cells(12, 1).CurrentRegion
    
    For j = 1 To UBound(sn) - 8
      If sn(j, 2) = Val(Left(c00, 1)) Then
        For jj = 0 To 31
            If sn(j + jj \ 4, jj Mod 4 + 2) <> Val(Mid(c00, jj + 1, 1)) Then Exit For
        Next
        
        If jj = 32 Then
            For jj = 1 To 168
                st((jj - 1) \ UBound(st, 2) + 1, (jj - 1) Mod UBound(st, 2) + 1) = sn(j - 10 + (jj - 1) \ UBound(st, 2) + 1, (jj - 1) Mod UBound(st, 2) + 1)
            Next
            Sheet2.Cells(Rows.Count, 12).End(xlUp).Offset(2).Resize(UBound(st), UBound(st, 2)) = st
        End If
      End If
    Next
End Sub

Display More

holycow · Dec 10th 2013

Re: Identify and number Patterns

Wow that's fast. Great job snb and KjBox.

The workbook I have has the 8 rows of the grid in B3:E10 so I had to change to this

Code

c00 = [B3&C3&D3&E3&B4&C4&D4&E4&B5&C5&D5&E5&B6&C6&D6&E6&B7&C7&D7&E7&B8&C8&D8&E8&B9&C9&D9&E9&B10&C10&D10&E10]

Then I did notice just one minor problem. The output on Sheet2 is

9 rows before
8 rows pattern
11 rows after

and it should be

10 rows before
8 rows pattern
10 rows after

snb · Dec 10th 2013

Re: Identify and number Patterns

Well, also KjBox & Pike asked for some finetuning:
The pattern is found in row < 10;
The pattern is found in row > rows.count-18
10 rows before & 10 rows after the pattern are being copied (unless the previous criteria)

NB. the criterion range: B2:E9

Code

Sub M_snb()
    Sheet2.Columns("L:Q").Clear
    c00 = [B2&C2&D2&E2&B3&C3&D3&E3&B4&C4&D4&E4&B5&C5&D5&E5&B6&C6&D6&E6&B7&C7&D7&E7&B8&C8&D8&E8&B9&C9&D9&E9]
    
    sn = Sheet1.Cells(12, 1).CurrentRegion
    
    For j = 1 To UBound(sn) - 8
      If sn(j, 2) = Val(Left(c00, 1)) Then
        For jj = 0 To 31
            If sn(j + jj \ 4, jj Mod 4 + 2) <> Val(Mid(c00, jj + 1, 1)) Then Exit For
        Next
        
        If jj = 32 Then
            ReDim st(1 To 28, 1 To 6)
            
            For jj = 1 To 168
                If j - 10 + (jj - 1) \ UBound(st, 2) > UBound(sn) Then Exit For
                If j < 10 And jj > UBound(sn, 2) * (19 - j) Then Exit For
                st((jj - 1) \ UBound(st, 2) + 1, (jj - 1) Mod UBound(st, 2) + 1) = sn(Application.Max(j - 11, 0) + (jj - 1) \ UBound(st, 2) + 1, (jj - 1) Mod UBound(st, 2) + 1)
            Next


            Sheet2.Cells(Rows.Count, 12).End(xlUp).Offset(2).Resize(UBound(st), UBound(st, 2)) = st
        End If
      End If
    Next
End Sub

Display More

holycow · Dec 10th 2013

Re: Identify and number Patterns

Perfectamundo

**KjBox** · Dec 10th 2013

Re: Identify and number Patterns

Not quite yet!

snb

The search criterion in the file larbec uses definitely goes from B3 to E10, I think the file you are testing on must have had row 1 deleted at some stage!

Still getting incorrect results when first instance of the pattern match starts in row 2 to 10 of the data. Here is a table of the output rows when a search pattern is inputted that results in the first found pattern begins in the row shown (if that makes sense!).

[TABLE="class: grid, width: 200"]

[tr]

[td]

Row

[/td]

[td]

Above

[/td]

[td]

Pattern

[/td]

[td]

Below

[/td]

[/tr]

[tr]

[TD="align: center"]1
[/TD]
[TD="align: center"]0
[/TD]
[TD="align: center"]8
[/TD]
[TD="align: center"]10
[/TD]

[/tr]

[tr]

[TD="align: center"]2
[/TD]
[TD="align: center"]1
[/TD]
[TD="align: center"]8
[/TD]
[TD="align: center"]8
[/TD]

[/tr]

[tr]

[TD="align: center"]3
[/TD]
[TD="align: center"]2
[/TD]
[TD="align: center"]8
[/TD]
[TD="align: center"]6
[/TD]

[/tr]

[tr]

[TD="align: center"]4
[/TD]
[TD="align: center"]3
[/TD]
[TD="align: center"]8
[/TD]
[TD="align: center"]4
[/TD]

[/tr]

[tr]

[TD="align: center"]5
[/TD]
[TD="align: center"]4
[/TD]
[TD="align: center"]8
[/TD]
[TD="align: center"]2
[/TD]

[/tr]

[tr]

[TD="align: center"]6
[/TD]
[TD="align: center"]5
[/TD]
[TD="align: center"]8
[/TD]
[TD="align: center"]0
[/TD]

[/tr]

[tr]

[TD="align: center"]7
[/TD]
[TD="align: center"]6
[/TD]
[TD="align: center"]6
[/TD]
[TD="align: center"]0
[/TD]

[/tr]

[tr]

[TD="align: center"]8
[/TD]
[TD="align: center"]7
[/TD]
[TD="align: center"]4
[/TD]
[TD="align: center"]0
[/TD]

[/tr]

[tr]

[TD="align: center"]9
[/TD]
[TD="align: center"]8
[/TD]
[TD="align: center"]1
[/TD]
[TD="align: center"]0
[/TD]

[/tr]

[tr]

[TD="align: center"]10
[/TD]
[TD="align: center"]9
[/TD]
[TD="align: center"]8
[/TD]
[TD="align: center"]11
[/TD]

[/tr]

[/TABLE]

So the 'above' rows are always correct but for a found pattern starting in row 2 to 10 gives decreasing numbers of rows 'below' rows and after rows 'below' reaches 0 rows of the pattern are left out, note row10 pattern start has 11 'below' rows. Row 1 and row 11 onwards are perfect.

larbec

Please can you let me know if you need the formatting in the data set on sheet 1 to be carried over to the results on sheet 2. If so then how much of the formatting? I see the following formats in the data set: Column A has coloured font for odd or even number and a coloured background, Columns B to E have conditional formatting for font colour and background colour, Column F has 3 colours of font, all cells with a border. As I say please let me know how many, if any, of these are needed in the results placed on Sheet 2.

snb · Dec 10th 2013

Re: Identify and number Patterns

KjBox

There seems to be a lot of fear among Excel users to use the first row and the fist column of a worksheet.
Because I am very VBA oriented I strongly advice not to keep 'them' row/column empty. It can disturb your VBA code considerably when using usedrange or in other cases cells(1).currentregion.
Besides there is no reason why the first row or column shouldn't be used.
So my code will always be applied to a worksheet of which the usedrange starts in cell A1.
Instead of adapting the code, in this case I recommend to adapt the worksheet.

By my intervention I tried to illustrate another method to attain the same goal.
Do not consider my suggestions as 'solutions'.
It's free to anybody to adapt/improve the code; that is the best way to master the code, to master the concept behind it and to master VBA.
So if you are not satisfied with the result if a matching pattern has been found in row <10, don't hesitate and adapt the suggestion.

larbec · Dec 11th 2013

Re: Identify and number Patterns

snb

What do you mean?

if you are not satisfied with the result if a matching pattern has been found in row <10, don't hesitate and adapt the suggestion

**KjBox** · Dec 11th 2013

Re: Identify and number Patterns

You are right, I should have taken the trouble to work through your code, see how it worked in detail, and then modify to get desired result.

I changed:

Code

If j < 10 And jj > UBound(sn, 2) * (19 -  j) Then Exit For

to:

Code

If j < 10 And jj > UBound(sn, 2) * (17 + j) Then Exit For

That sorted it.

larbec

snb's code is the best for you to use. Very fast and will take account of any changes to the data set without needing to run an update after changes are made. Also it does not use formulae on the sheet so you can delete column H, this will cut you file size down considerably. The extra speed and file size saving will become even more apparent as you add more rows to the data set. If you let me know your formatting requirements for the results I will try to incorporate them.

holycow · Dec 11th 2013

Re: Identify and number Patterns

Well done KjBox

larbec · Dec 11th 2013

Re: Identify and number Patterns

Hey y'all, I am so confused which one to use. Can you PLEASE provide me with the link or location and do I need to do anything to it after I DL it?

also, can I add more rows to it? I mean say instead of 10 before and after .... Say 20?

**KjBox** · Dec 11th 2013

Re: Identify and number Patterns

Larbec:

It is extremely difficult to help you get the result you want if every time a solution is found you move the goal posts!!!

Please state exactly what it is you want 10 rows or 20 rows or do you want to be able to select a different number of rows each time?

Also what about the formatting of the results on sheet 2 (see my earlier post)?

When you let us know your FINAL requirements we can upload a working file for you to download.

**pike** · Dec 11th 2013

Re: Identify and number Patterns

This is Larbec thread
larbec had found a solution .. now we have another piece of code that will not do what he requires ( unless he changes it ) .. Larbec use the code that was working for you .. posted by Holwcow.. this thread is closed

snb · Dec 11th 2013

Re: Identify and number Patterns

I think it clearly illustrates my point: don't use code you do not understand.
As soon as the goalposts are moving a 'solution' doesn't work anymore, but a grasped 'approach' could be adapted to the new requirements.

**KjBox** · Dec 13th 2013

Re: Identify and number Patterns

Adaptations done.

Now the number of lines of data before and after each instance of a pattern match which are to be included in the results can be seperately set before searching for the pattern. Also, the number of rows of data that make up the search criterion can be varied.

This is the original, excellent code written by snb, modified. also a link to the file. The structure of the worksheet had to be altered to accommodate the changes so to run the code a previously downloaded file must be altered to suit the code, or the new file downloaded.

Code

Sub PatternSearch()
Dim c00, sn, st
Dim j, jj As Long, dPRw As Double, sPat As String
Dim iAbv, iBlw As Integer, rCel, rPtn As Range
iAbv = [N3]
iBlw = [N4]
dPRw = Range("H3:H" & Range("H" & Rows.Count).End(xlUp).Row).Cells.Count
Set rPtn = Range("H3:K" & Range("K" & Rows.Count).End(xlUp).Row)
    
    If [N3] = vbNullString Or [N4] = vbNullString Then
        MsgBox "You must enter a value (even if it is 0) for Above and Below", , "Missing Value"
        Exit Sub
    End If
    For Each rCel In rPtn
        sPat = sPat & rCel
    Next
    c00 = [sPat]
    If Len(c00) <> dPRw * 4 Then
        MsgBox "Search criterion not complete. Enter 4 numbers for each row.", , "Criteria missing"
        Exit Sub
    End If
    Sheet2.Columns("L:Q").ClearContents
    sn = Sheet1.Cells(1, 1).CurrentRegion
    For j = 1 To UBound(sn) - dPRw
        If sn(j, 2) = Val(Left(c00, 1)) Then
            For jj = 0 To (dPRw * 4) - 1
                If sn(j + jj \ 4, jj Mod 4 + 2) <> Val(Mid(c00, jj + 1, 1)) Then Exit For
            Next
            If jj = dPRw * 4 Then
                ReDim st(1 To (dPRw + iAbv + iBlw), 1 To 6)
                For jj = 1 To (dPRw + iAbv + iBlw) * 6
                    If j - iAbv + (jj - 1) \ UBound(st, 2) > UBound(sn) Then Exit For
                    If j < iAbv And jj > UBound(sn, 2) * (dPRw + iBlw - 1 + j) Then Exit For
                     st((jj - 1) \ UBound(st, 2) + 1, (jj - 1) Mod UBound(st, 2) + 1) =  sn(Application.Max(j - (iAbv + 1), 0) + (jj - 1) \ UBound(st, 2) + 1,  (jj - 1) Mod UBound(st, 2) + 1)
                Next
                Sheet2.Cells(Rows.Count, 12).End(xlUp).Offset(2).Resize(UBound(st), UBound(st, 2)) = st
            End If
        End If
    Next
    With Sheet2
        .Columns("Q").AutoFit
        .[L1] = "Search Results"
    End With
    If Sheet2.[L3] = vbNullString Then
        MsgBox "No matching pattern found", , "No Match"
        Application.Goto ([L2])
    Else
        Application.Goto (Sheet2.[L1])
    End If
End Sub

Display More

https://www.dropbox.com/s/06gp…n_Search_Using_Arrays.zip

Identify and number Patterns

Participate now!

Share