Looking for multiple terms (sorted by priority) - vba

Would it be possible to use the find method to search for back-up options?
Here's my code right now:
Set foundCell = Cells.Find(What:="RCP 1", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If Not foundCell Is Nothing Then
foundCell.Activate
foundCell.Rows("1:1").EntireRow.Select
Selection.Copy
Range("A" & (PLcount + 8)).Select
ActiveSheet.Paste
Else
Set foundCell = Cells.Find(What:="RCP- 1", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If Not foundCell Is Nothing Then
foundCell.Activate
foundCell.Rows("1:1").EntireRow.Select
Selection.Copy
Range("A" & (PLcount + 8)).Select
ActiveSheet.Paste
End If
End If
I would like to be able to do something like below. Note the text after .Find(What:=)
Set foundCell = Cells.Find(What:="RCP 1" "RCP- 1" "RCP 1", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If Not foundCell Is Nothing Then
foundCell.Activate
foundCell.Rows("1:1").EntireRow.Select
Selection.Copy
Range("A" & (PLcount + 8)).Select
ActiveSheet.Paste
End If
Where the first term is the first priority, the second term is the second priority, the third term is the third priority, etc.

EDIT - there is only limited support for wildcards in Find() - you would probably not class it as "regex-level" functionality:
* - zero or more characters
? - single character
~ - escapes * or ? if you want to find those literal characters
Alternatively can put the Find into a separate function:
Sub Tester()
Dim foundCell, PLCount As Long
PLCount = 3
Set foundCell = FindFirst(Cells, Array("RCP 1", "RCP- 1"))
If Not foundCell Is Nothing Then
'no need for any select/activate
foundCell.EntireRow.Copy Destination:=Range("A" & (PLCount + 8))
End If
End Sub
'return the first match to a value in the array "arrWhat"
' Returns Nothing if no match
Function FindFirst(rngWhere, arrWhat) As Range
Dim v, f As Range
For Each v In arrWhat
Set f = rngWhere.Find(what:=v, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not f Is Nothing Then Exit For
Next v
Set FindFirst = f
End Function

Related

VBA .Find and .Union Method

I'm new to VBA. I want to find the headers of six columns and join them using the union method. Once they are joined as BigColumns, I want to change the font size to 14.
I've already tried looping, but given that I am new to this I wanted to try a simpler way. I can successfully run this code on one range, such as TC1, and change the font to 14. But as soon as I try combining ranges, it fails.
Sub ASOLDPrintFormatTesting2()
Dim Table As Range
Dim BigColumns As Range
Dim TC1, TC2, TC3, TC4, TC5, TC6 As Range
'TC stands for Table Columns These individual ranges are joined through
Union Method
Set ReferenceCell = ActiveCell
Set WS = Sheets(2)
With WS
Set ReferenceCell = Cells.Find(What:="Source #", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'Make Source # the Reference Cell, or the equivalent of A1
If Not ReferenceCell Is Nothing Then
Set ReferenceCell = Cells.Find(What:="Sample #", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
End If
'Make Sample # the Reference Cell
Set Table = ReferenceCell.CurrentRegion
With Table
Set TC1 = .Find(What:="Source Well", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set TC2 = .Find(What:="Sample ID", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set TC3 = .Find(What:="VerboseConc_uM", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set TC4 = .Find(What:="VerboseConc_ug/ml", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set TC5 = .Find(What:="Mol Wt.", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set TC6 = .Find(What:="N/Mole", LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'Find all headers of BigColumns
Set BigColumns = Application.Union(Range("TC1"), Range("TC2"), _
Range("TC3"), Range("TC4"), Range("TC5"), Range("TC6"))
'Union of all headerrs as BigColumns
If Not BigColumns Is Nothing Then
Else
MsgBox "'BigColumns' not found"
Exit Sub
End If
End With
With BigColumns
.Cells.Font.Size = 14
End With
'Test to see if BigColumns works
End With
End Sub
No error messages are produced when the code runs.
Using an array (will give a snippit example), you should be able to loop and save some time and possible issues where things are not found:
dim arr as variant, i as long
arr = array("Source Well","Sample ID") 'can add more
with table
for i = lbound(arr) to ubound(arr)
set f = .find(what:=arr(i))
if not f is nothing then f.font.size = 14
next i
end with
-untested code-
You find your item, if it's not found it skips changing the font size.

vba Entire Column should copy

" find " cell value in header will keep changing in raw file, i need " find " cell value ENTIRE column should copy and paste in sheet2
Sub Macro3()
Cells.Find(What:="FSP Center", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate`
Cells.FindNext(After:=ActiveCell).Activate`
Columns("A:A").Select 'i want to select entire column
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
End Sub
Sub Macro3()
Dim f As Range
Set f = Rows(1).Find(What:="FSP Center", After:=ActiveCell, _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not f Is Nothing Then
f.EntireColumn.Copy Sheets("Sheet2").Range("A1")
End If
End Sub
'fixed the misspelling "If"

VBA Run-Time Error 91 - 2

I have a macro which works for the first 36 rows but then shows a run-time 91 error. It shows the error in find statement. The purpose of the macro is to calculate the 90th percentile of the figures populated in a column, count the number of values which are equal or greater the percentile, and provide the division across various departments. Can anybody please help me to correct the error?
For bb = 1 To temcnt
cc = Sheets("tem").Cells(bb, ttc + 4).Value
Sheets("Geographic Strength").Activate
Cells.Find(What:=cc, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ff1 = ActiveCell.Column
Sheets("tem").Activate
rnggg = Range(Cells(2, 6), Cells(ttr, 6))
mamm = WorksheetFunction.CountIf(Range(Cells(2, 6), Cells(ttr, 6)), cc)
Sheets("geographic strength").Activate
f222 = Sheets("individual strength").Cells(1, iii).Value
**Cells.Find(What:=f222, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
f333 = ActiveCell.Row**
'Error is in the above statement(Cells.Find)
Cells(f333, ff1).Value = mamm
Next bb
Sheets("tem").Delete
Next iii
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
it's because
Cells.Find(What:=f222, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
didn't succeed in finding the wanted cell so it returns Nothing, and you can't Activate Nothing
so you could go like follows:
'... your code before
f222 = Sheets("individual strength").Cells(1, iii).Value
Dim found As Range
Set found = Cells.Find(What:=f222, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If Not found Is Nothing Then '<-- check if any cell has been found
found.Activate
f333 = ActiveCell.Row
'... rest of your code should f222 have been found
End If
' rest of your code

Deleting Rows of Data not Needed

Dim mRange As Range
Columns("B:B").Select
i = 0
Set mRange = Range("B:B")
mRange.Find(What:="TRUE", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Rows(ActiveCell.Row).Select
Selection.Delete Shift:=xlUp
For i = 0 To 1
Columns("B:B").Select
Set mRange = Range("B:B")
mRange.Find(What:="TRUE", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Rows(ActiveCell.Row).Select
Selection.Delete Shift:=xlUp
Do While Not mRange Is Nothing
Set mRange = Range("B:B")
mRange.Select
mRange.Find(What:="TRUE", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Rows(ActiveCell.Row).Select
Selection.Delete Shift:=xlUp
Loop
Next i
The above code correctly deletes out the rows where a cell has the word "TRUE" in it, but receives this error when it can no longer find "TRUE". It does not jump out of the loop, but hangs at the final mRange.Find method. What have I done wrong? Thx.
"Run-time error 91, Object variable or With block variable not set"
As the comments suggest, get rid of .Select.
This code should be all that's needed.
Do
Dim sAdd as String
sAdd = vbNullString
Dim rFound as Range
Set rFound = Range("B:B").Find(What:="TRUE", After:=Cells(Rows.Count,Columns.Count), LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False)
If Not rFound is Nothing Then
sAdd = rFound.Address
rFound.EntireRow.Delete Shift:=xlUp
End If
Loop Until sAdd = vbNullString
This will also work and may be faster if the rowset isn't extremely large.
Dim lRow as Long
lRow = Range("B" & Rows.Count).End(xlUp).Row
With Range("B1:B" & lRow)
.AutoFilter 1, TRUE
.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.AutoFilter
End With
Application.ScreenUpdating = False
Dim rFound As Range
Dim mRange As Range
Set mRange = Range("B:B")
Do
Set rFound = mRange.Find(What:="TRUE", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
If Not rFound Is Nothing Then rFound.EntireRow.Delete
Loop Until rFound Is Nothing
Application.ScreenUpdating = True

If (search term) found, do (action). If not, end if

If you guys could help me out, that would be great because it would really help me.
Here's what I'm trying to do:
Search for a cell with a specific term
If found, copy the entire row that the cell is in and paste it into a row above it.
If not found, do nothing and continue with the code
Here's my code:
Sub Test()
'
' Test Macro
'
' Keyboard Shortcut: Ctrl+b
'
Range("A5").Select
Cells.Find(What:="PL 1", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
If Not IsEmpty(ActiveCell.Value) Then
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Copy
Range("A5").Select
ActiveSheet.Paste
End If
Range("A5").Select
Cells.Find(What:="PL 2", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
If Not IsEmpty(ActiveCell.Value) Then
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Copy
Range("A6").Select
ActiveSheet.Paste
End If
Range("A5").Select
Cells.Find(What:="PL 3", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
If Not IsEmpty(ActiveCell.Value) Then
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Copy
Range("A7").Select
ActiveSheet.Paste
End If
End Sub
My code only works if the value is found. If it's not found it runs into the error below:
Cells.Find is a function that returns a Range object reference; when it doesn't find anything, the reference will be Nothing. And you can't call .Activate on Nothing:
This method returns Nothing if no match is found. The Find method does not affect the selection or the active cell. (MSDN)
Cells.Find(What:="PL 2", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
You need to rewrite your code and avoid .Select and .Activate, and avoid working with ActiveCell and implicitly with ActiveSheet (which you are doing by not qualifying the Cells call with a proper worksheet reference).
Your formatting makes it hard to read the code, for several reasons:
Arguments are being specified on different lines
Line continuations are being palced at arbitrary locations
Nested member calls aren't lined up
Compare to:
Cells.Find(What:="PL 2", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False) _
.Activate
That's just readability. The problem is that you basically assume that .Find returns a valid object reference. Don't assume, explicitly check:
Set result = Cells.Find(...)
If Not result Is Nothing Then result.Activate
But really, you need to figure out a way to avoid .Select and .Activate.
You can try something like this instead (untested):
Sub HideAndSeek()
Dim foundCell As Range
For i = 1 To 3
Set foundCell = Cells.Find(What:="PL " & i, LookIn:=xlFormulas, LookAt:=xlPart)
If Not foundCell Is Nothing Then
Intersect(foundCell.EntireRow, ActiveSheet.UsedRange).Offset(-1, 0).Value = _
Intersect(foundCell.EntireRow, ActiveSheet.UsedRange).Value
End If
Set foundCell = Nothing
Next
End Sub
The principle being that you write the code you need once and then create a loop to repeat the code for you.
The other part of this answer is checking that the cell was found - to do this we check that the range was actually set (which means it isn't Nothing) using
If Not foundRange Is Nothing