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,

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

Sub FindPatterns_V3()
' 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 + 1
lrp = Cells(Rows.Count, 4).End(xlUp).Row
If lra < lrp - 2 Then
  Cells(3, 12) = 0
  Exit Sub
End If
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
    sr = a.Row + 1
    Set a = Nothing
  End If
Next nc
MyFinish:
Cells(4, 8).Resize(UBound(o, 1), 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_V3 macro.

 

[Peter_SSs]

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

Yes, Transpose with greater than 65,536 rows.

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.

That still seems to be the case with the code in post #21.


I used the original OP's data with just two cells in the pattern area as this gave 20 matches throughout the range.
D3: 1
D4: 1.41

Hiker's post #21 code took approx. 20 seconds on my machine & missed the pattern match starting at row 119,608.

Snakehips code from post #16: Approx 0.7 seconds

Code below: Approx 0.5 seconds

Sub Find_Pattern()
  Dim Data, Patt, Results
  Dim i As Long, j As Long, k As Long, ubPatt As Long

  Data = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
  Patt = Range("D3", Range("D" & Rows.Count).End(xlUp)).Value
  ReDim Results(1 To UBound(Data, 1), 1 To 2)
  ubPatt = UBound(Patt, 1)
  For i = 1 To UBound(Data, 1) - ubPatt + 1
    j = 0
    Do
      If Data(i + j, 1) <> Patt(j + 1, 1) Then j = ubPatt
      If j = ubPatt - 1 Then
        k = k + 1
        Results(k, 1) = i
        Results(1, 2) = Results(1, 2) + 1
      End If
      j = j + 1
    Loop Until j >= ubPatt
  Next i
  Range("H4", Range("H4").End(xlDown)).Resize(, 2).ClearContents
  Range("H4").Resize(k, 2).Value = Results
End Sub

One further point that the OP may need to clarify is a situation like this:

Excel Workbook
	A	B	C	D
1	1
2	2
3	1			1
4	2			2
5	1			1
6	2			2
7	1			1
8	2
9	1
10	2
11	1
12
Test

My code, Snakehips & Hiker's (if the row 1 issue was fixed) all report 4 matches (rows 1, 3, 5 & 7). Not sure if that would be the required answer or whether it may be just two matches (rows 1 and 7)?

 

[hiker95]

Peter_SSs,

In reference to your Find_Pattern macro in reply #22 - nicely done, and, another one for my archives - thank you very much.