Welcome to ShenZhenJia Knowledge Sharing Community for programmer and developer-Open, Learning and Share
menu search
person
Welcome To Ask or Share your Answers For Others

Categories

 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

 If phm <> 0 Then

 phm = Split(phm, ",")
 ReDim number(LBound(phm) To UBound(phm)) As Integer

 Set sh = w.Worksheets("sheet1")
sh.Select
Cells.Find("Number Type").Select

Set rn = sh6.UsedRange
k = rn.Rows.Count + rn.Row - 1
On Error Resume Next
For i = 1 To k
For j = LBound(number) To UBound(number)
number(j) = CInt(phm(j))
If Err.number = 0 Then
If ActiveCell.Value = number(j) Or IsEmpty(ActiveCell.Value) Then
Selection.Interior.ColorIndex = xlNone
Else
Selection.Interior.Color = vbGreen
Exit For
End If
End If

Next j
ActiveCell.Offset(1, 0).Select 'moves activecell down one row.
Next i


End If
ActiveWorkbook.Save


End Sub

I want to modify the above code in such a way that alphabets are ignored if present in any cell.

For example, a cell may contain "hello 9811",then it should not be highlighted.Checking should be done only on numbers in the cell

phm contains data like this: "9811,7849" etc..

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
thumb_up_alt 0 like thumb_down_alt 0 dislike
109 views
Welcome To Ask or Share your Answers For Others

1 Answer

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

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
thumb_up_alt 0 like thumb_down_alt 0 dislike
Welcome to ShenZhenJia Knowledge Sharing Community for programmer and developer-Open, Learning and Share
...