Reputation: 27
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
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