Find patterns in data points

[Ghris]

Hello,

I wonder if there is a way to check for a certain pattern in a list of data points.

This image might clarify what I am looking for. I need a way to check if the pattern exists (and where) in the data points.

I have tried with vlookup but only got it to work with finding 1 number.

 

[hiker95]

Ghris,

I am having a problem downloading your huge workbook.

Can you post another workbook, with just 1000 rows of raw data?

Let me see what I can do with the screenshot from Snakehips.

 

[Rick Rothstein]

Ghris,

I am having a problem downloading your huge workbook.

Oh good... I thought it was just my computer (which I have rebooted twice now hoping to solve the download problem).

 

[Rick Rothstein]

Ghris,

I am having a problem downloading your huge workbook.

Can you post another workbook, with just 1000 rows of raw data?

Let me see what I can do with the screenshot from Snakehips.

Oh good... I thought it was just my computer (which I have rebooted twice now hoping to solve the download problem).

Also working with the layout that Snakehips shows, here is my code revised to highlight the cells in Column A (that match the pattern) in yellow and to list the starting row numbers in Column H for each location..

Sub FindPattern()
  Dim X As Long, Index As Long, Commas As Long, Rw As Long, PatLen As Long, RowNums As Variant
  Dim DataPoints As String, Pattern As String, Parts() As String
  ReDim RowNums(1 To Cells(Rows.Count, "A").End(xlUp).Row, 1 To 1)
  DataPoints = "," & Join(Application.Transpose(Range("A2", Cells(Rows.Count, "A").End(xlUp))), ",,") & ","
  Pattern = "," & Join(Application.Transpose(Range("D3", Cells(Rows.Count, "D").End(xlUp))), ",,") & ","
  Columns("A").Interior.ColorIndex = xlColorIndexNone
  Parts = Split(DataPoints, Pattern)
  PatLen = UBound(Split(Replace(Pattern, ",,", ","), ",")) - 1
  Rw = 2
  For X = 0 To UBound(Parts) - 1
    Commas = UBound(Split(Replace(Parts(X), ",,", ","), ","))
    Rw = Rw + Commas + 1 - 2 * (Len(Parts(X)) = 0)
    Cells(Rw - 2, "A").Resize(PatLen).Interior.ColorIndex = 6
    Index = Index + 1
    RowNums(Index, 1) = Rw - 2
    Rw = Rw + PatLen - 2
  Next
  Range("H4:H" & UBound(RowNums)) = RowNums
End Sub

 

[hiker95]

Ghris,

My latest macro will fail/not produce the correct results, if cell A1 = D3. Let me see if I can work out the correct code, for the above case.


After my latest macro:

Excel 2007
	A	B	C	D	E	F	G	H	I	J	K	L
1	136.19
2	1.72			Look for the following pattern:				Result:				Matches
3	1.06			1.77				The pattern occurs at this row(s):				1
4	1.09			3.19				16
5	6.55			2.99
6	2.13			1.15
7	2.19			2.59
8	1173.54			1.09
9	2.14			1.75
10	2.23			4.53
11	11.51			1.03
12	1.47			3.74
13	1.88
14	9.15
15	86.81
16	1.77
17	3.19
18	2.99
19	1.15
20	2.59
21	1.09
22	1.75
23	4.53
24	1.03
25	3.74
26	5.18
27	5.41
28
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

If you place the below macro code in a module that already has Option Base 1, you will have to delete one of these lines of code.

Option Base 1
Sub FindPatterns_V2()
' hiker95, 11/23/2014, ME820043
Dim p As Variant, o As Variant
Dim i As Long, j As Long
Dim lra As Long, lrp As Long
Dim a As Range
Dim n As Long, nc As Long, sr As Long, nr As Long, pc As Long, nf As Long
n = Application.CountIf(Columns(1), Cells(3, 4).Value)
If n = 0 Then
  MsgBox ("There are no '" & Cells(3, 4).Value & "' values in column A - macro terminated!")
  Exit Sub
End If
Application.ScreenUpdating = False
ReDim o(1 To n, 1 To 1)
lra = Cells(Rows.Count, 1).End(xlUp).Row
lrp = Cells(Rows.Count, 4).End(xlUp).Row
p = Range("D3:D" & lrp)
sr = 1
For nc = 1 To n
  Set a = Range("A" & sr & ":A" & lra).Find(Range("D3").Value, LookAt:=xlWhole)
  If Not a Is Nothing Then
    pc = 1: nr = a.Row
    For i = 2 To UBound(p, 1)
      nr = nr + 1
      If nr > lra Then GoTo MyFinish
      If Cells(nr, 1) = p(i, 1) Then
        pc = pc + 1
      End If
    Next i
    If pc = UBound(p, 1) Then
      j = j + 1
      o(j, 1) = a.Row
      nf = nf + 1
    End If
  End If
  sr = a.Row
Next nc
MyFinish:
Cells(4, 8).Resize(, UBound(o, 2)).Value = o
Cells(3, 12) = nf
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the FindPatterns_V2 macro.

 

[Rick Rothstein]

Also working with the layout that Snakehips shows, here is my code revised to highlight the cells in Column A (that match the pattern) in yellow and to list the starting row numbers in Column H for each location..

Sub FindPattern()
....
....
End Sub

Whoops! I missed that Snakehips' layout started the values in Column A at Row 1 (no header) rather than at Row 2 (with A1 being a header) like I originally assumed. This code uses Snakehips' layout exactly (data points start in cell A1, pattern starts in cell D3 and outputted Row numbers start in cell H4)...

Sub FindPattern()
  Dim X As Long, Index As Long, Commas As Long, Rw As Long, PatLen As Long, RowNums As Variant
  Dim DataPoints As String, Pattern As String, Parts() As String
  ReDim RowNums(1 To Cells(Rows.Count, "A").End(xlUp).Row, 1 To 1)
  DataPoints = "," & Join(Application.Transpose(Range("A1", Cells(Rows.Count, "A").End(xlUp))), ",,") & ","
  Pattern = "," & Join(Application.Transpose(Range("D3", Cells(Rows.Count, "D").End(xlUp))), ",,") & ","
  Columns("A").Interior.ColorIndex = xlColorIndexNone
  Parts = Split(DataPoints, Pattern)
  PatLen = UBound(Split(Replace(Pattern, ",,", ","), ",")) - 1
  Rw = 2
  For X = 0 To UBound(Parts) - 1
    Commas = UBound(Split(Replace(Parts(X), ",,", ","), ","))
    Rw = Rw + Commas + 1 - 2 * (Len(Parts(X)) = 0)
    Cells(Rw - 3, "A").Resize(PatLen).Interior.ColorIndex = 6
    Index = Index + 1
    RowNums(Index, 1) = Rw - 3
    Rw = Rw + PatLen - 2
  Next
  Range("H4:H" & UBound(RowNums)) = RowNums
End Sub

 

[Snakehips]

Sorry for the delay, was all but ready to post this over two hours ago but life interrupted

Given the posted layout, this should deal with as much data as you like in A and with a variable number of values for the Pattern in D, and is none too sluggish.

Excel 2007
	A	B	C	D	E	F	G	H	I	J
1	136.19
2	1.72			Look for the following pattern:				Result:
3	1.06			1.77				The pattern occurs at this cell(s):
4	1.09			3.19				A16	12	Matches
5	6.55			2.99				A700
6	2.13			1.15				A60000
7	2.19			2.59				A98696
8	1173.54			1.09				A98853
9	2.14			1.75				A197386
10	2.23			4.53				A408297
11	11.51			1.03				A408628
12	1.47			3.74				A1014206
13	1.88							A1014333
14	9.15							A1014419
15	86.81							A1014630
16	1.77
17	3.19
Sheet2

Sub Pattern_Match()


Dim Drng As Range
Dim Prng As Range
Dim Found As Range
Dim LstA, LstD, LstH, MtchCount, c  As Long
Dim Mtch As Integer
Dim PArry As Variant


Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


LstA = Cells(Rows.Count, "A").End(xlUp).Row
LstD = Cells(Rows.Count, "D").End(xlUp).Row
LstH = Cells(Rows.Count, "H").End(xlUp).Row
If LstH < 4 Then LstH = 4
Set Drng = Range("A1:A" & LstA)
Set Prng = Range("D3:D" & LstD)
Set Hrng = Range("H4:D" & LstH)
Range("H4:H" & LstH).ClearContents
Range("I4").ClearContents
If LstA = 1 Or LstD = 2 Then Exit Sub
PArry = Prng
MtchCount = 0
Set LstCell = Drng.Cells(Drng.Cells.Count, 1)
Set Found = Drng.Find(What:=PArry(1, 1), After:=LstCell)
If Not Found Is Nothing Then
    First = Found.Address
End If
Do Until Found Is Nothing
    Mtch = 1
        For c = LstD - 2 To 2 Step -1
            If Not PArry(c, 1) = Found.Offset(c - 1, 0) Then
                Mtch = 0
                Exit For
            End If
        Next c
        
    If Mtch = 1 Then
        MtchCount = MtchCount + 1
        Range("H3").Offset(MtchCount, 0) = Found.Address(False, False)
    End If
    
    Set Found = Drng.FindNext(After:=Found)
    If Found.Address = First Then Exit Do
     
Loop
Range("I4") = MtchCount
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic


End Sub

Hope that helps.

 

[Rick Rothstein]

Given the posted layout, this should deal with as much data as you like in A and with a variable number of values for the Pattern in D, and is none too sluggish.

Were you able to down the OP's file from his link? For some reason I cannot (and it looks like hiker95 cannot either). If so, can I ask you to do me a favor and run the code I posted in Message #15 and tell me (us) how it does? Thanks.

 

[Snakehips]

Were you able to down the OP's file from his link? For some reason I cannot (and it looks like hiker95 cannot either). If so, can I ask you to do me a favor and run the code I posted in Message #15 and tell me (us) how it does? Thanks.

Hi Rick, Hiker,

Yes I was able to download the OP's file and the inconsistent header rows are as per that download.

A1:A277775 contained values > 0 but then the remaining 700,000+ rows contained nothing but zeros!!! So it was clogged up with nothing, big time!!
There was no obvious match for the OP pattern and no means to find any until a solution was developed so I copied a random 10 cells from A16 and pasted them here and there for testing.
I have subsequently found that there was just one OP pattern match at row 235340!!!!

Rick, Initially, I tried your code on my original test file and it ran but returned nothing at all. ????
However, given Hiker's request to OP to post a smaller file, I trimmed it down to 1000 rows . On that reduced data set, your code worked perfectly!, returning the same set of results as my code.

Is it some Excel restriction on array size that would have caused that?

If you wish me to upload the reduced file for you access then just let me know. (But don't delay too much as some of us mere mortals need to go to bed!! )

 

[Rick Rothstein]

Rick, Initially, I tried your code on my original test file and it ran but returned nothing at all. ????
However, given Hiker's request to OP to post a smaller file, I trimmed it down to 1000 rows . On that reduced data set, your code worked perfectly!, returning the same set of results as my code.

Is it some Excel restriction on array size that would have caused that?

If you wish me to upload the reduced file for you access then just let me know. (But don't delay too much as some of us mere mortals need to go to bed!! )

If you wish me to upload the reduced file for you access then just let me know. (But don't delay too much as some of us mere mortals need to go to bed!! )

Could I ask you to email it to me? Also the original file that it did not work on? My email addess is...

rick DOT news AT verizon DOT net

 

[hiker95]

Ghris,

If we start off with this, we get this:

Excel 2007
	A	B	C	D	E	F	G	H	I	J	K	L
1	1.77
2	3.19			Look for the following pattern:				Result:				Matches
3	2.99			1.77				The pattern occurs at this row(s):				0
4	1.15			3.19
5	2.59			2.99
6				1.15
7				2.59
8				1.09
9				1.75
10				4.53
11				1.03
12				3.74
13
Sheet1

If we start off with this, we get this:

Excel 2007
	A	B	C	D	E	F	G	H	I	J	K	L
1	1.77
2	3.19			Look for the following pattern:				Result:				Matches
3	2.99			1.77				The pattern occurs at this row(s):				1
4	1.15			3.19				6
5	2.59			2.99
6	1.77			1.15
7	3.19			2.59
8	2.99			1.09
9	1.15			1.75
10	2.59			4.53
11	1.09			1.03
12	1.75			3.74
13	4.53
14	1.03
15	3.74
16
Sheet1

If we start off with this, we get this:

Excel 2007
	A	B	C	D	E	F	G	H	I	J	K	L
1	1.77
2	3.19			Look for the following pattern:				Result:				Matches
3	2.99			1.77				The pattern occurs at this row(s):				1
4	1.15			3.19				20
5	136.19			2.99
6	1.72			1.15
7	1.06			2.59
8	1.09			1.09
9	6.55			1.75
10	2.13			4.53
11	2.19			1.03
12	1173.54			3.74
13	2.14
14	2.23
15	11.51
16	1.47
17	1.88
18	9.15
19	86.81
20	1.77
21	3.19
22	2.99
23	1.15
24	2.59
25	1.09
26	1.75
27	4.53
28	1.03
29	3.74
30	5.18
31	5.41
32
Sheet1

See my next reply for the macro code.