vba searching a range for array string elements : subscript out of range errors

[Andyatwork]

Hi all,

This is a follow on query to my earlier question;
http://www.mrexcel.com/forum/excel-...g-over-run-time-1004-unable-get-findnext.html

I have a range of cells on a worksheet, each cell containing a text string. This range of cells will be added to by the end user over time.

I am trying to pass this dynamic range to an array and then searching for each array element in a different range. When a match is found the code will cut the row and dump it into a second sheet.

I can get code to work if I explicitly define a single search term but I am having Subscript out of range trouble when trying to loop through array elements. I suspect I am missing something simple.

All the googling I have done finds solutions where the elements of the array are explicitly stated in the VBA.

Option Explicit
    Public srcName As Range             'the range in Tables of the Name search terms
    Public tables As Worksheet, dead As Worksheet
    Public wb As Workbook
        Option Base 1
Sub check_names()
    Dim srcArr() As Variant      'search terms array
    Dim lvrStr As String           'term to search for
    Dim fndRng As Range         'found cell containing search term
    Dim Rcount As Long          'counter
    Dim i As Long               'counter
    Dim tbllrow As Long, lrow As Long
'    With Application
'        .ScreenUpdating = False
'        .EnableEvents = False
'    End With
    
'''for testing
    Set wb = ActiveWorkbook
    Set tables = wb.Sheets("Tables")
    Set dead = wb.Sheets("Deceased")
    
'   check last row of search terms range in "tables" tab
    With tables
        tbllrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
'   set range of search terms 
    Set srcName = tables.Range("A5:A" & tbllrow)
    srcArr = srcName  [COLOR=#ff0000]'my attempt to pass the range to the array[/COLOR]
    
'   Check last used row of dump tab
    With dead
        Rcount = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    
    
    With Sheets(1).Range("f:f")         'range being searched
        For i = LBound(srcArr) To UBound(srcArr)
           lvrStr = srcArr(i)   [COLOR=#ff0000]'subscript out of range error here[/COLOR]
            Set fndRng = .Find(What:=lvrStr, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
                    
            If Not fndRng Is Nothing Then
                Do
                    Rcount = Rcount + 1
                    fndRng.EntireRow.Cut dead.Range("A" & Rcount)
                    Set fndRng = .FindNext(fndRng)
                Loop While Not fndRng Is Nothing
            End If
        Next i
    End With
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

i've also tried using srcArr(i) in place of lvrStr Set fndRng = .Find(What:=lvrStr, and get the same error.

I was trying to use a For i...next i loop to cycle the strings in the array to the lvrStr term and then search the range for each newly defined search term, but it no worky.

Hopefully someone can tell me what schoolboy error I am making.

Many thanks

Andy

 

[NiceCyte]

lvrStr = srcArr(i) 'subscript out of range error here

You're having trouble with this line because lvrStr is a string, while srcArr is an array. srcArr, even though it may be just 1 column of data in excel, it is still referenced using (x,y) type coordinates. So srcArr(i) is actually trying to pass an entire row of data to a string. I believe this is the error, even though "Tables" may just be one column of data.

If the "Tables" data you're referencing is in fact just one column, change it to this:

lvrStr = srcArr(i, 1)

That will always reference the 1st column, and go down the column as you iterate through i.

I hope that helps.

 

[Andyatwork]

Magic, sorted the problem and explained it to me beautifully, thank you very much indeed.

Kind regards

Andy