• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Why can't I search to the end of my spreadsheet

Status
Not open for further replies.
I do not want to double post but I accidently posted this on the excel forum and afterwards realized it belongs here so my apologies


I have this Macro that searches for specific groups of numbers. I added another 300,000 rows and when I search for say a group that is all the way almost on the bottom of my spreadsheet it does not find it as if it is limited to only go to a certain row. Can anyone tell me what may be wrong with my MACRO? I have 750,000 rows presently and will be adding more

https://app.box.com/s/ci5xymcdj3fe5c2wjjqf

Thanks

Here is the MACRO

Code:
Option Explicit

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(12, 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
 
Status
Not open for further replies.
Back
Top