Makiko
Makiko

Reputation: 27

Excel VBA finding a text and return row number (loop)

I am finding a difficulty in probably a rather simple code to return the corresponding row numbers which contain a specific text in column("A:A"). Have been trying several ways but without success - it does not loop through the last row. Here is what I have got so far:

Dim rowCount As Integer
Dim i As Integer
Dim FindRow As Variant
Dim RowN As Integer
Dim blockSize As Integer

rowCount = Range("A1").CurrentRegion.Rows.Count
 
For i = 2 To rowCount 
    
    Set FindRow = Cells(i, 1).Find(What:="group: 1", LookAt:=xlPart, SearchOrder:=xlByRows)
    RowN = FindRow.Row
    MsgBox RowN

    If RowN > 1 Then
    blockSize = FindRow.Row - 1
    MsgBox blockSize
    End If

Next i

Upvotes: 0

Views: 2862

Answers (1)

Darren Bartrup-Cook
Darren Bartrup-Cook

Reputation: 19847

Your Find is only searching one cell in the region. Using that method you should use Instr to check each cell.

The Find method will find the first occurrence in a range, and FindNext will find subsequent occurrences.

Option Explicit
    
Sub Test()

    Dim lastrow As Long
    
    With ThisWorkbook.Worksheets("Sheet1")
        lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
        
        Dim srchRange As Range
        Set srchRange = .Range(.Cells(1, 1), .Cells(lastrow, 1))
    End With
    
    With srchRange
        Dim rFound As Range
        Set rFound = .Find("group: 1", .Cells(1, 1), xlValues, xlPart, , xlNext, False)
        If Not rFound Is Nothing Then
            Dim firstAdd As String
            firstAdd = rFound.Address
            
            Dim FoundRows As String
            Dim blocksize As Long
                
            Do
                If rFound.Row > 1 Then
                    blocksize = rFound.Row - 1
                    'other code.
                    
                End If
                Set rFound = .FindNext(rFound)
            Loop Until rFound.Address = firstAdd
        
        End If
    End With

End Sub

If you wanted to add more flexibility to the process you could rewrite it as a function so you can search different groups, different columns and different sheets.

Sub Test1()

    Dim Result As Variant
    Result = GetBlocks(, , ThisWorkbook.Worksheets("Sheet1"))
    
    If IsEmpty(Result) Then
        MsgBox "No groups found."
    Else
        Dim itm As Variant
        For Each itm In Result
            MsgBox itm
        Next itm
    End If

End Sub

Function GetBlocks(Optional GroupID As String = "group: 1", _
                   Optional ColNum As Long = 1, _
                   Optional wrkSht As Worksheet) As Variant
                   
    'Optional arguments must be constant expressions, so a
    'default worksheet can't be set before here.
    If wrkSht Is Nothing Then Set wrkSht = ActiveSheet

    'Define the range to be searched.
    With wrkSht
        Dim lastrow As Long
        lastrow = .Cells(.Rows.Count, ColNum).End(xlUp).Row
        
        Dim srchRange As Range
        Set srchRange = .Range(.Cells(1, ColNum), .Cells(lastrow, ColNum))
    End With
    
    With srchRange
        Dim rFound As Range
        Set rFound = .Find(GroupID, .Cells(1, 1), xlValues, xlPart, , xlNext, False)
        If Not rFound Is Nothing Then
            Dim firstAdd As String
            firstAdd = rFound.Address
            
            'Create a string of row numbers.
            'e.g. 4,6,8,11,13,14,16,17, < note final comma.
            Dim FoundRows As String
            Do
                If rFound.Row > 1 Then
                    FoundRows = FoundRows & rFound.Row & ","
                End If
                Set rFound = .FindNext(rFound)
            Loop Until rFound.Address = firstAdd
            
            'Split string into arrow of row numbers.
            'These will be string data types.
            Dim tmp As Variant
            tmp = Split(FoundRows, ",")
            
            'Convert string to long data type.
            ReDim tmp1(0 To UBound(tmp) - 1)
            Dim x As Long
            For x = 0 To UBound(tmp1)
                tmp1(x) = CLng(tmp(x))
            Next x
            
            'Return result of function.
            GetBlocks = tmp1
            
        End If
    End With

End Function

Upvotes: 2

Related Questions