Function searchUsingKeywordTable(haystackRef As Range, needleTable As Range, Optional toggle As Integer = 1) As Variant
'Like the Search worksheet function but allows searching from multiple keywords. Keywords can be more than one word apiece and contain any text.
'haystackRef is a single cell reference with text to be searched. Ex "A1"
'needleTable is a range, such as "A1:A10", that includes the keywords column. Do NOT include column headers or the Assigned to Coulmn.
'When toggle is:
'1: function returns the first keyword found in the searched text, or "#NA" if no keyword not found
'2: function returns the position of the first letter of the first keyword found in the searched text, or "#NA" if no keyword found
'Default value for toggle is 1
searchUsingKeywordTable = CVErr(xlErrNum)
Dim haystack As String
haystack = haystackRef.Value
'Although not an issue in this challenge, we dont want capitalization to throw off the search function, so lets make everything the same case
haystack = UCase(haystack)
'Now we loop through each keyword, using the Instr fxn to see of any of the keywords are in the haystack
'Note the use of the cleanerText function. Although not needed for this challenge, this function makes it so that cells in the keyword
' column that are blank, or contain only spaces or even other non-space ascii whitespace or nonprinting characters, will not be searched for
Dim cll As Object
Dim cllValue As String
For Each cll In needleTable
cllValue = cll.Value
If InStr(1, haystack, UCase(trim(cllValue))) And cleanerText(cllValue, True, True, True) <> "" Then
If toggle = 1 Then
searchUsingKeywordTable = cllValue
Else
searchUsingKeywordTable = InStr(1, haystack, UCase(cllValue))
End If
Exit For
End If
Next cll
End FunctionFunction cleanerText(text As String, Optional ConvertBreakingChars As Boolean = False, Optional RemoveNonPrintables As Boolean = False, Optional trimString As Boolean = False) As String
'Replaces all nonbreaking whitespace characters with spaces
'If ConvertBreakingChars is set to TRUE, also sets breaking whitespacecharacters to spaces (default is false)
'If RemoveNonPrintables is set to TRUE, removes nonprinting characters (default is false)
'If trimString is set to TRUE, trims spaces on both sides of string (default is false)
'Add special characters to an array
Dim Wspace() As String
ReDim Wspace(1 To 6) As String
Wspace(1) = Chr(9)
Wspace(2) = Chr(0)
Wspace(3) = Chr(1)
Wspace(4) = Chr(2)
Wspace(5) = Chr(3)
Wspace(6) = Chr(160)
If ConvertBreakingChars = True Then
ReDim Preserve Wspace(1 To 8) As String
Wspace(7) = Chr(10)
Wspace(8) = Chr(13)
End If
'Loop through the array, replacing all wspace characters with spaces
Dim i As Integer
i = 1
Do While i < (UBound(Wspace) + 1)
Do While InStr(1, text, Wspace(i))
text = Replace(text, Wspace(i), " ")
Loop
i = i + 1
Loop
If RemoveNonPrintables = True Then
text = Application.WorksheetFunction.Clean(text)
End If
If trimString = True Then
text = trim(text)
End If
cleanerText = text
End FunctionFunction ReverseLOOKUP(rngCell As Range, rngTable As Range, lngColumn As Long) As String
Application.Volatile
Dim rng As Range
If ((lngColumn > rngTable.Columns.Count) Or (lngColumn < 1)) Then
ReverseLOOKUP = "#REF!"
Else
For Each rng In rngTable.Columns(1).Cells
If InStr(1, rngCell.Value, rng.Value) > 0 Then
ReverseLOOKUP = Cells(rng.Row, rng.Column + lngColumn - 1)
Exit For
End If
Next rng
End If
Set rng = Nothing
End FunctionSub subParseColor()
Dim iCompareCol As Integer
Dim iCompareRow As Integer
Dim iLookupTableCol As Integer
Dim iLookupTableRow As Integer
Dim strCompare As String
Dim strLookupTable As String
iCompareCol = 1
iCompareRow = 2
iLookupTableCol = 4
iLookupTableRow = 2
With ActiveSheet
strCompare = .Cells(iCompareRow, iCompareCol).Value
strLookupTable = .Cells(iLookupTableRow, iLookupTableCol).Value
While strCompare <> ""
While strLookupTable <> ""
If (InStr(1, strCompare, strLookupTable)) Then _
.Cells(iCompareRow, iCompareCol + 1).Value = _
IIf(.Cells(iCompareRow, iCompareCol + 1).Value <> "", _
.Cells(iCompareRow, iCompareCol + 1).Value & " / " & _
.Cells(iLookupTableRow, iLookupTableCol + 1).Value, _
.Cells(iLookupTableRow, iLookupTableCol + 1).Value)
iLookupTableRow = iLookupTableRow + 1
strLookupTable = .Cells(iLookupTableRow, iLookupTableCol).Value
Wend
iLookupTableRow = 2
strLookupTable = .Cells(iLookupTableRow, iLookupTableCol).Value
iCompareRow = iCompareRow + 1
strCompare = .Cells(iCompareRow, iCompareCol).Value
Wend
End With
End Sub
