Find a string in a column and return and return an array with row numbers - excel

I want to search in a column and find a string. However, there are several cells with that string and I want to return an array that contains all row position.
Dim r As Range
Set r = Sheets("Sheet3").columns(3).Find(What:="TEST", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
this return only the first row, but not all.
How can I return all of rows that contain "TEST"?
Thanks.

This should do the trick...
It will loop through Column 3 of Sheet3 to produce an array containing the row numbers of every occurrence of TEXT. Based on the options used in your example, it is case sensitive and must occupy the whole cell.
Sub demo_FindIntoArray()
Const searchFor = "TEST" 'case sensitive whole-cell search term
Const wsName = "Sheet3" 'worksheet name to search
Const colNum = 3 'column# to search
Dim r As Range, firstAddress As String, strTxt As String, arrRows
With Sheets("Sheet3").Columns(3)
Set r = .Find(searchFor, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not r Is Nothing Then
firstAddress = r.Address
Do
If strTxt <> "" Then strTxt = strTxt & ","
strTxt = strTxt & r.Row
Set r = .FindNext(r)
Loop While Not r Is Nothing And r.Address <> firstAddress
End If
End With
If strTxt <> "" Then
arrRows = Split(strTxt,",")
MsgBox "Found " & UBound(arrRows)+1 & " occurrences of '" & searchFor & "':" & vbLf & vbLf & strTxt
Else
MsgBox "'" & searchFor & "' was not found."
End If
'[arrRows] is now an array containing row numbers
End Sub
It works by first building a string with a comma separated list of values, and then using the Split function to split it into an array.

This will unionize the ranges that equal "Test",
Sub SelectA1()
Dim FrstRng As Range
Dim UnionRng As Range
Dim c As Range
Set FrstRng = Range("C:C").SpecialCells(xlCellTypeConstants, 23)
For Each c In FrstRng.Cells
If LCase(c) = "test" Then
If Not UnionRng Is Nothing Then
Set UnionRng = Union(UnionRng, c) 'adds to the range
Else
Set UnionRng = c
End If
End If
Next c
UnionRng.Select ' or whatever you want to do with it.
End Sub

You don't indicate what you want to do with the results. However, you can return an array of the row numbers containing the word "TEST" with a worksheet formula:
Case Insensitive:
=AGGREGATE(15,6,SEARCH("TEST",$C:$C)*ROW($C:$C),ROW(INDIRECT("1:" & COUNTIF($C:$C,"*TEST*"))))
Case Sensitive:
=AGGREGATE(15,6,FIND("TEST",$C:$C)*ROW($C:$C),ROW(INDIRECT("1:" & SUMPRODUCT(--ISNUMBER(FIND("TEST",$C:$C))))))
Case Insensitive; cell = test (eg entire cell contents):
=AGGREGATE(15,6,1/($C:$C="test")*ROW($C:$C),ROW(INDIRECT("1:"&COUNTIF($C:$C,"test"))))
If you want to use this array for something else, such as to return the contents of the rows where the third column = "test", you could also do this with a filter, either in VBA or on the worksheet.
There are many different appropriate solutions, depending on what you are going to do with the results of these row numbers.

Related

Find specific text or dates inside a range and mark line with a specific colour

I have report were I use a VBA Macro to get a list from a large amount of Raw Data.
I have a very specific need, I hope someone can help me with.
My range is from A5:I500, each line from A:I has information to a specific need.
If a cell in the "H" Column has a specific text (in my case "Unconfirmed"), I would like The entire line (for instance A5:I5 or A26:I26), to be marked in a specific color.
If "H" Column has a date which is later than the date of "today", I would like the line (for instance A5:I5 or A26:I26), to be marked in a specific color.
If "H" Column has a date which is before the date of "today", I would like the line (for instance A5:I5 or A26:I26), to be marked in a specific color.
I want to end up like this
I found code which turns just the specific cell in the color I want.
How do I change this code to fill the entire Line from A:I on every line which contains "unconfirmed"?
Sub test1()
Dim FirstAddress As String
Dim MySearch As Variant
Dim myColor As Variant
Dim Rng As Range
Dim I As Long
MySearch = Array("Unconfirmed")
myColor = Array("3")
With Sheets("Ronnie").Range("A5:I1000")
For I = LBound(MySearch) To UBound(MySearch)
Set Rng = .Find(What:=MySearch(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
Rng.Interior.ColorIndex = myColor(I)
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
Next I
End With
End Sub
This code will use if statements to check the data, and assign colour to the range of cells on that row.
Sub ColourRng()
Dim RNum As Integer
RNum = 1
For I = 1 To 500
If Sheets("Ronnie").Range("H" & RNum) = "Unconfirmed" Then
Sheets("Ronnie").Range("A" & RNum & ":I" & RNum).Interior.ColorIndex = 6
Else
If Sheets("Ronnie").Range("H" & RNum) >= Date Then
Sheets("Ronnie").Range("A" & RNum & ":I" & RNum).Interior.ColorIndex = 4
Else
If Sheets("Ronnie").Range("H" & RNum) < Date Then
Sheets("Ronnie").Range("A" & RNum & ":I" & RNum).Interior.ColorIndex = 3
End If
End If
End If
RNum = RNum + 1
Next I
End Sub

How do I compare one string to many other strings?

I'm trying to compare two list of names, and find the names who are on both lists. However the lists are not in the same order and of different lengths.
I tried a code compare the first name of the first list ("A1") to the first one in the other list ("B1"), and then compare it to the second ("B3") and so on until it matches. If it matches it writes "Match" on the third column, or "Not a match" if there is no match
Sub CompareTest()
Dim iComp As Integer, i As Integer, j As Integer
Dim str1 As string, str2 As string
For i = 1 to 20
str1 = ("A" & i)
For j = 1 to 20
str2 = ("B" & j)
iComp = StrComp(str1, str2, vbTextCompare)
Select Case iComp
Case 0
Range ("C" & i) = "Match"
Case 1
Range ("C" & i) = "Match"
End Select
If Range ("C" & i) = "Match" Then Exit For
Next j
Next i
End Sub
Right now, the code writes "Not a match" in every cell from 1 to 20 even though there are matches, and I'm not sure what's not working.
In your code, you are comparing the strings "An" and "Bn" and not the contents of the address. But even if you correct that, you are still writing "Match" if str1 is equal to or greater than str2. Probably not what you want.
You can probably do something like:
C1: =IF(COUNTIF(B:B,A1),"Match","Not a Match")
or, in code
Option Explicit
Sub matcher()
Dim WS As Worksheet
Dim C As Range, rSearch As Range, rLookup As Range
Set WS = Worksheets("sheet2")
With WS
Set rLookup = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
Set rSearch = .Range(.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp))
.Columns(3).Clear
End With
For Each C In rLookup
If rSearch.Find(what:=C, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False) Is Nothing Then
C.Offset(0, 2) = "No Match"
Else
C.Offset(0, 2) = "Match"
End If
Next C
End Sub

Match The Nth Instance In Excel

I am using the match function on spreadsheets and the spreadsheets have the same keywords but in different rows, I am attempting to get the row number and to do this I want to use the second instance of a keyword. How would this be done in VBA my current code is
Application.WorksheetFunction.Match("Hello", Range("A1:A100"), 0)
I was thinking about using the Index function, but I am not exactly sure how to use it.
Start the second match just below the first:
Sub dural()
Dim rw As Long
With Application.WorksheetFunction
rw = .Match("Hello", Range("A1:A1000"), 0)
rw = .Match("Hello", Range("A" & (rw + 1) & ":A1000"), 0) + rw
MsgBox rw
End With
End Sub
If you want the Nth match, I would use Find() and a FindNext() loop.
EDIT#1:
Another way to find the Nth instance is to Evaluate() the typical array formula within VBA. For N=3, in the worksheet, the array formula would be:
=SMALL(IF(A1:A1000="Hello",ROW(A1:A1000)),3)
So with VBA:
Sub dural()
Dim rw As Long, N As Long
N = 3
rw = Evaluate("SMALL(IF(A1:A1000=""Hello"",ROW(A1:A1000))," & N & ")")
MsgBox rw
End Sub
Here is a method using Range.Find.
Option Explicit
Sub FindSecond()
Dim rSearch As Range, C As Range
Const sSearchFor As String = "Hello"
Dim sFirstAddress As String
Set rSearch = Range("A1:A100")
With rSearch 'Note that search starts at the bottom
Set C = .Find(what:=sSearchFor, after:=rSearch(.Rows.Count, 1), _
LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, _
searchdirection:=xlNext, MatchCase:=False)
If Not C Is Nothing Then
sFirstAddress = C.Address
Set C = .FindNext(C)
If C.Address <> sFirstAddress Then
MsgBox "2nd instance of " & sSearchFor & " on row " & C.Row
Else
MsgBox "Only one instance of " & sSearchFor & " and it is on row " & C.Row
End If
Else
MsgBox "No instance of " & sSearchFor
End If
End With
End Sub
There might be a better way, but this works:
=MATCH("Hello",INDIRECT("A"&(1+MATCH("Hello",A1:A100,0))&":A100"),0)
This would return the index of the second occurrence, by searching for the first occurrence and using that to define the range to search for the next one.

how to iterate over all rows of a excel sheet in VBA

I have this code (This code is in Access VBA which tries to read an excel file and after checking, possibly import it):
Set ExcelApp = CreateObject("Excel.application")
Set Workbook = ExcelApp.Workbooks.Open(FileName)
Set Worksheet = Workbook.Worksheets(1)
now I want to iterate over all rows of the excel worksheet. I want something such as this:
for each row in Worksheet.rows
ProcessARow(row)
next row
where
function ProcessARow(row as ???? )
' process a row
' how Should I define the function
' how can I access each cell in the row
' Is there any way that I can understand how many cell with data exist in the row
end function
My questions:
How to define the for each code that it iterate correctly on all
rows that has data?
How to define ProcessARow properly
How to get the value of each cell in the row.
How to find how many cell with data exist in the row?
Is there any way that I detect what is the data type of each cell?
edit 1
The link solves on problem :
How to define the for each code that it iterate correctly on all rows that has data?
but what about other questions?
For example, how to define ProcessARow correctly?
If you need the values in the Row, you need use the 'Value' Property and after do an cycle to get each value
for each row in Worksheet.rows
Values=row.Value
For each cell in Values
ValueCell=cell
next cell
next row
Unfortunately you questions are very broad however I believe the below sub routine can show you a few ways of achieving what you are after. In regards to what datatype each cell is more involved as it depends what data type you wish to compare it to however I have included some stuff to hopefully help.
sub hopefullyuseful()
dim ws as worksheet
dim rng as Range
dim strlc as string
dim rc as long, i as long
dim lc as long, j as long
dim celltoprocess as range
set ws = activeworkbook.sheets(activesheet.name)
strlc = ws.cells.specialcells(xlcelltypeLastCell).address
set rng = ws.range("A1:" & lc)
rc = rng.rows.count()
debug.print "Number of rows: " & rc
lc = rng.columns.count()
debug.print "Number of columns: " & lc
'
'method 1 looping through the cells'
for i = 1 to rc
for j = 1 to lc
set celltoprocess = ws.cells(i,j)
'this gives you a cell object at the coordinates of (i,j)'
'[PROCESS HERE]'
debug.print celltoprocess.address & " is celltype: " & CellType(celltoprocess)
'here you can do any processing you would like on the individual cell if needed however this is not the best method'
set celltoprocess = nothing
next j
next i
'method 2 looping through the cells using a for each loop'
for each celltoprocess in rng.cells
debug.print celltoprocess.address & " is " & CellType(celltoprocess)
next celltoprocess
'if you just need the data in the cells and not the actual cell objects'
arrOfCellData = rng.value
'to access the data'
for i = lbound(arrOfCellData,1) to ubound(arrOfCellData,1)
'i = row'
for j = lbound(arrOfCellData,2) to ubound(arrOfCellData,2)
'j = columns'
debug.print "TYPE: " & typename(arrOfCellData(i,j)) & " character count:" & len(arrOfCellData(i,j))
next j
next i
set rng=nothing
set celltoprocess = nothing
set ws = nothing
end sub
Function CellType(byref Rng as range) as string
Select Case True
Case IsEmpty(Rng)
CellType = "Blank"
Case WorksheetFunction.IsText(Rng)
CellType = "Text"
Case WorksheetFunction.IsLogical(Rng)
CellType = "Logical"
Case WorksheetFunction.IsErr(Rng)
CellType = "Error"
Case IsDate(Rng)
CellType = "Date"
Case InStr(1, Rng.Text, ":") <> 0
CellType = "Time"
Case IsNumeric(Rng)
CellType = "Value"
End Select
end function
sub processRow(byref rngRow as range)
dim c as range
'it is unclear what you want to do with the row however... if you want
'to do something to cells in the row this is how you access them
'individually
for each c in rngRow.cells
debug.print "Cell " & c.address & " is in Column " & c.column & " and Row " & c.row & " has the value of " & c.value
next c
set c = nothing
set rngRow = nothing
exit sub
if you want your other questions answered you will have to be more specific as to what you are trying to accomplish
While I like the solution offered by #krazynhazy I believe that the following solution might be slightly shorter and closer to what you asked for. Still, I'd use the CellType function offered by Krazynhazy rather than all the Iif I currently have in the below code.
Option Explicit
Sub AllNonEmptyCells()
Dim rngRow As Range
Dim rngCell As Range
Dim wksItem As Worksheet
Set wksItem = ThisWorkbook.Worksheets(1)
On Error GoTo EmptySheet
For Each rngRow In wksItem.Cells.SpecialCells(xlCellTypeConstants).EntireRow.Rows
Call ProcessARow(wksItem, rngRow.Row)
Next rngRow
Exit Sub
EmptySheet:
MsgBox "Sheet is empty." & Chr(10) & "Aborting!"
Exit Sub
End Sub
Sub ProcessARow(wksItem As Worksheet, lngRow As Long)
Dim rngCell As Range
Debug.Print "Cells to process in row " & lngRow & ": " & wksItem.Range(wksItem.Cells(lngRow, 1), wksItem.Cells(lngRow, wksItem.Columns.Count)).SpecialCells(xlCellTypeConstants).Count
For Each rngCell In wksItem.Range(wksItem.Cells(lngRow, 1), wksItem.Cells(lngRow, wksItem.Columns.Count)).SpecialCells(xlCellTypeConstants)
Debug.Print "Row: " & lngRow, _
"Column: " & rngCell.Column, _
"Value: " & rngCell.Value2, _
IIf(Left(rngCell.Formula, 1) = "=", "Formula", IIf(IsDate(rngCell.Value), "Date", IIf(IsNumeric(rngCell.Value2), "Number", "Text")))
Next rngCell
End Sub
Note, that you have to call the sub to call a row must also include the sheet on which a row should be processed.

Find and delete header columns without a certain word.

I need to:
1. Find a column containing the word 'target' in header. (from the range P1 to QI1 )
2. Delete all other column without 'target' in its header.
Code:
Sub Cleanup()
Dim rng As Range
With ActiveSheet.Range("P1:QI1")
Set rng = ActiveSheet.Range("P1:QI1").Find(What:="target", _
LookAt:=xlPart, MatchCase:=False)
Do While Not rng Is Nothing
rng.EntireColumn.Delete
Set rng = .FindNext
Loop
End With
End Sub
the code above is deleting all the column with the word 'target'. i would like it the other way around. i need to keep those columns.
thanks in advance.
TESTED - enjoy :)
Sub test()
Dim erange As Range
Dim str As String
For Each erange In Range("A1:E1")
If not erange.Value = "Target" Then
' If InStr(erange.Value, "Target") <> 0 Then
If str <> "" Then
str = str & "," & erange.EntireColumn.Address
Else
str = erange.EntireColumn.Address
End If
End If
Next erange
str = Replace(str, "$", "")
' Delete columns in single shot
Range(str).Delete
End Sub

Resources