@Jack BeNimble
thanks for the code, used it successfully in 10 mins to highlight all the numbers in a cell. I reorganized it a tad, searching all search terms within a row and cell first and allowed for multiple columns. I found one error, your highlight text didn't like repeats 55, 444, only highlighted the odd repeats in a sequence. Modified one line in Highlight Function
newOffset = offSet + foundPos + Len(searchString) - 1 //added the - 1.
here is my modified code.
Sub NumberColors()
Dim searchTerms As Variant
searchTerms = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".")
Dim searchString As String
Dim targetString As String
Dim offSet As Integer
Dim colsToSearch As Variant
Dim arrayPos, colIndex, colNum As Integer
Dim rowNum As Integer
colsToSearch = Array(4, 44, 45)
For colIndex = LBound(colsToSearch) To UBound(colsToSearch)
colNum = colsToSearch(colIndex)
For rowNum = 5 To 3000
For arrayPos = LBound(searchTerms) To UBound(searchTerms)
searchString = Trim(searchTerms(arrayPos))
offSet = 1
Dim x As Integer
targetString = Cells(rowNum, colNum).Value
x = HilightString(offSet, searchString, rowNum, colNum)
Next arrayPos
Next rowNum
Next colIndex
End Sub
Function HilightString(offSet As Integer, searchString As String, rowNum As Integer, ingredCol As Integer) As Integer
Dim x As Integer
Dim newOffset As Integer
Dim targetString As String
' offet starts at 1
targetString = Mid(Cells(rowNum, ingredCol), offSet)
foundPos = InStr(LCase(targetString), searchString)
If foundPos > 0 Then
' the found position will cause a highlight where it was found in the cell starting at the offset - 1
Cells(rowNum, ingredCol).Characters(offSet + foundPos - 1, Len(searchString)).Font.Color = vbBlue
' increment the offset to found position + 1 + the length of the search string
newOffset = offSet + foundPos + Len(searchString) - 1
x = HilightString(newOffset, searchString, rowNum, ingredCol)
Else
' if it's not found, come back out of the recursive call stack
Exit Function
End If
End Function
Thanks Jack BeNimbleand datatoo