Function Find_Row_Multi_Criteria(Sheet_Spec, Primary_String, Primary_Col, _ Secondary_String, Secondary_Col, _
Optional Look_At As xlLookAt = xlPart, _
Optional Search_Order As XlSearchOrder = xlByRows, _
Optional Match_Case As Boolean = False, _
Optional Third_String = "", Optional Third_Col = 0, _
Optional Fourth_String = "", Optional Fourth_Col = 0, _
Optional Fifth_String = "", Optional Fifth_Col = 0)
' Returns Row Number found or 0. Uses Find_String
' 2/14/17 Created. WML
' 2/24/17 Reworked
Dim SHEET As Worksheet
Const Array_Size = 4
Dim Search_Cols(Array_Size)
Dim Search_Strings(Array_Size)
Prog = "Find_Row_Multi_Criteria"
Call Sheet_Arg(Sheet_Spec, SHEET, Sheet_Name)
LastRow = Last_Row(SHEET)
Search_Strings(1) = Secondary_String: Search_Cols(1) = Secondary_Col
Search_Strings(2) = Third_String: Search_Cols(2) = Third_Col
Search_Strings(3) = Fourth_String: Search_Cols(3) = Fourth_Col
Search_Strings(4) = Fifth_String: Search_Cols(4) = Fifth_Col
Rng = Make_Range(1, Primary_Col, -1, Primary_Col, SHEET)
Do While Find_String(SHEET, Rng, Primary_String, Ans_Row, Ans_Col, xlPart, , mlAny)
Test = True
For I = 1 To Array_Size
Match_String = Search_Strings(I)
If Match_String <> "" Then
If Match_String <> SHEET.Cells(Ans_Row, Search_Cols(I)) Then
Test = False
Exit For
End If
End If
Next I
If Test Then
Find_Row_Multi_Criteria = Ans_Row
Exit Function
End If
Rng = Make_Range(Ans_Row + 1, Primary_Col, LastRow, Primary_Col)
Loop
Find_Row_Multi_Criteria = 0
End Function ' Find_Row_Multi_Criteria()
Function Find_String(SheetName_or_Sheet, _
Range_or_Col_Nr, SEARCH_FOR, Answer_Row, Answer_Col, _
Optional Look_At As xlLookAt = xlWhole, _
Optional Case_Sensitive As Boolean = False, _
Optional Where_in_String As ml_Where = mlWhole, _
Optional Look_In As XlFindLookIn = xlValues) As Boolean
' Lookup a String in a Sheet and return its address in ROW and COL.
' Note: The Sheet must be in the currently opened Workbook.
' Note: Look_At can have values "xlPart" or "xlWhole".
' 12/22/10 Replaced Find_Sub. WML
' 12/22/10 Replaced xlLookAts Enum. WML
' 8/20/16 Added Where to Look (ml_Where). WML
' 12/23/16 made Search_For ByVal. WML
' 12/23/16 Changed Arg references. WML
' 12/23/16 Took out argument "Look_At" as it's controlled by Where_in_String. WML
Prog = "Find_String"
Dim SHEET As Worksheet
Dim Found_Range As Range, Last_Range As Range
If Is_Nr(Range_or_Col_Nr) Then
TS = Col_Ptr(Range_or_Col_Nr)
Search_Range = Make_Range_Cols(TS, TS)
Else
Search_Range = Range_or_Col_Nr
End If
Call Sheet_Arg(SheetName_or_Sheet, SHEET, Sheet_Name)
With SHEET.Range(Search_Range)
TS = TypeName(Search_Range)
Set Last_Range = .Cells(.Cells.Count)
Set rngSearch = SHEET.Range(Search_Range)
Set rng_Last = rngSearch.Cells(rngSearch.Cells.Count)
Set Found_Range = .Find( _
What:=SEARCH_FOR, _
After:=rng_Last, _
LookIn:=Look_In, _
LookAt:=Look_At, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=Case_Sensitive, _
SearchFormat:=False)
If Not Found_Range Is Nothing Then
'saves the address of the first occurrence of "OldItem", _
in the First_Address variable:
First_Address = Found_Range.ADDRESS
Do
' Find next occurrence of "Search_For". _
Note, that we do not start from the first occurrence of "OldItem" (ie. First_Address).
Answer_Row = Found_Range.Row
Answer_Col = Found_Range.Column
Data = SHEET.Cells(Answer_Row, Answer_Col)
If Not Case_Sensitive Then Data = UCase(Data)
Ptr = InStr(Found_Range, SEARCH_FOR)
Select Case Where_in_String
Case mlStart
If Ptr = 1 Then
Find_String = True
Exit Function
End If
Case mlAny
If Ptr > 0 Then
Find_String = True
Exit Function
End If
Case mlEnd
If (Ptr + Len(SEARCH_FOR) - 1) = Len(Data) Then
Find_String = True
Exit Function
End If
Case mlWhole
If InStr(1, Data, SEARCH_FOR, vbTextCompare) = 1 Then
Find_String = True
Exit Function
End If
Case mlMiddle
If InStr(1, Data, SEARCH_FOR, vbTextCompare) > 0 Then
Find_String = True
Exit Function
End If
End Select
Set Found_Range = .FindNext(Found_Range)
' The Loop ends on reaching the first occurrence of "OldItem" ie. First_Address). _
We have retained the value of "OldItem" till this step because if in the first occurrence, _
"OldItem" had been replaced by "NewItem", this step would give an error.
Loop Until Found_Range.ADDRESS = First_Address
End If
End With
Find_String = False
End Function ' Find_String
