Here's a modified version of your program. The program tries to convert the cell's value to an integer. Only if it succeeds in doing so, then Activecell.Value
is compared to number(j)
.
Sub Highlight()
...same code as yours...
Cells.Find("hello").Select
ActiveCell.Offset(1, 0).Select
Set rn = sh.UsedRange
k = rn.Rows.Count + rn.Row - 1
' ignore errors related to CInt conversion that will follow
On Error Resume Next
For x = 1 To k
For j = 0 To UBound(number)
' try to convert value to integer
TempNumber = CInt(ActiveCell.Value)
' if value was an integer, work on it
If Err.number = 0 Then
If ActiveCell.Value <> number(j) Then
Selection.Interior.Color = vbYellow
Else
Selection.Interior.ColorIndex = xlNone
Exit For
End If
End If
Next j
ActiveCell.Offset(1, 0).Select 'moves activecell down one row.
Next x
End Sub
EDIT based on change in requirement
Sub Test()
highlight ("9811,7849")
End Sub
Sub highlight(phm As Variant)
Dim w As Workbook
Dim sh As Worksheet
Dim x As Integer
Dim rn As Range
Dim k As Long
Dim number() As Integer
' newly added variables
Dim TempNumber As Integer
Dim phmInt As Variant
Dim phmFound As Boolean
If phm <> 0 Then
' split the numbers
phm = Split(phm, ",")
ReDim number(LBound(phm) To UBound(phm)) As Integer
Set sh = Worksheets("sheet1")
sh.Select
Cells.Find("Number Type").Select
Set rn = sh.UsedRange
k = rn.Rows.Count + rn.Row - 1
For i = 1 To k
On Error Resume Next
' try to check if active cell is an integer
' and proceed only if it is an integer
TempNumber = CInt(ActiveCell.Value)
If Err.number = 0 Then
On Error GoTo 0
' set phmFound to false and then see if
' active cell's value matches any item in phm array
phmFound = False
For Each phmInt In phm
If CInt(ActiveCell.Value) = CInt(phmInt) Then
phmFound = True
Exit For
End If
Next phmInt
' if active cell's value matched at least one item
' in phm array, don't colorize it. Otherwise colorize it
ActiveCell.Select
If phmFound Then
Selection.Interior.ColorIndex = xlNone
Else
Selection.Interior.Color = vbGreen
End If
End If
Err.Clear
ActiveCell.Offset(1, 0).Select 'moves activecell down one row.
Next i
End If
End Sub
EDIT
Requirement: 9811 and 7848 are entered so any cell in this format- hello 9811,9811,7848,abc 7848 should NOT be highlighted...remaining cells with any other content other than the above mentioned should be highlighted
Sub Test()
highlight ("9811,7848")
End Sub
Sub highlight(phm As Variant)
Dim w As Workbook
Dim sh As Worksheet
Dim x As Integer
Dim rn As Range
Dim k As Long
Dim number() As Integer
' newly added variables
Dim TempNumber As Integer
Dim phmInt As Variant
Dim phmFound As Boolean
If phm <> 0 Then
' split the numbers
phm = Split(phm, ",")
ReDim number(LBound(phm) To UBound(phm)) As Integer
Set sh = Worksheets("sheet1")
sh.Select
Cells.Find("Number Type").Select
Set rn = sh.UsedRange
k = rn.Rows.Count + rn.Row - 1
For i = 1 To k
' does the cell have the number we are looking for?
phmFound = False
For Each phmInt In phm
TempNumber = InStr(Trim(ActiveCell.Text), CStr(phmInt))
If TempNumber > 0 Then
' check if there is any number after phmint
If Not IsNumeric(Mid(Trim(ActiveCell.Text), TempNumber + Len(CStr(phmInt)), 1)) Then
phmFound = True
Exit For
End If
End If
Next phmInt
' if active cell's value matched at least one item
' in phm array, don't colorize it. Otherwise colorize it
ActiveCell.Select
If phmFound Then
Selection.Interior.ColorIndex = xlNone
Else
Selection.Interior.Color = vbGreen
End If
ActiveCell.Offset(1, 0).Select 'moves activecell down one row.
Next i
End If
End Sub
与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…