findnext cease to function

[bulina2k]

Hello guys!
The following code works very well:

Please Login or Register  to view this content.

but if I put some code into loop, FindNext doesn't work anymore:

Please Login or Register  to view this content.

Any ideas?

Thanks!

[romperstomper]

If you use another Find within the loop, your original FindNext won't work. You have to use Find again repeating all the parameters.

[Sa DQ]

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Const Rws0 As Long = 165
 If Not Intersect(Target, [e5]) Is Nothing Then
    Dim Sh As Worksheet, Rng As Range, sRng As Range
    Dim MyAdd As String:                            ReDim Arr(11 To 165, 1 To 7)
    Dim Tmr As Double, Rws As Long, Col As Long, Offs As Long, Hg As Long
    
    Rows("11:" & Rws0).Hidden = False:              Tmr = Timer
    Range("B11:G" & Rws0).ClearContents:            Randomize
    Target.Interior.ColorIndex = 34 + 9 * Rnd() \ 1
    Application.ScreenUpdating = False
    Set Sh = ThisWorkbook.Worksheets("NKC"):        Hg = 11
    Rws = Sh.[E65500].End(xlUp).Row:                Set Rng = Sh.Range("F8:G" & Rws)
    Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
    If sRng Is Nothing Then
        [e11].Value = "Nothing":                    Rows("13:" & Rws0).Hidden = True
    Else
        MyAdd = sRng.Address                        '<=|'
        Do
            Rws = sRng.Row:                         Col = sRng.Column
            If Col = 6 Then Offs = 1 Else Offs = -1
            Arr(Hg, 1) = Sh.Cells(Rws, "B").Value
            Arr(Hg, 2) = Sh.Cells(Rws, "c").Value
            Arr(Hg, 3) = Sh.Cells(Rws, "D").Value
            Arr(Hg, 4) = Sh.Cells(Rws, "e").Value
            Arr(Hg, 5) = sRng.Offset(, Offs).Value
            Arr(Hg, Col) = Sh.Cells(Rws, "H").Value
            Hg = 1 + Hg
            Set sRng = Rng.FindNext(sRng)           '<=|'
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
    [B11].Resize(Hg + 1, 7).Value = Arr()
    Rws = [e10].End(xlDown).Row + 2
    If Rws > Rws0 Then
        [e11].Value = "Nothing":                    Rws = 13
    End If
    Rows(Rws & ":" & Rws0).Hidden = True
    Application.ScreenUpdating = True
    [k65500].End(xlUp).Offset(1).Value = Timer - Tmr
 End If
End Sub