CODEWITHSUNDEEP
excelvba
at.trk
at.trk

Reputation: 3

InStr to find exact number in specific cell

If the cell contains a testcode it should clear the 4th next cell, but this way it will find all the codes which contain the numbers. So if a code contains an 1, it will clear the next cell which shouldn't be happening.

Set rng = ws.Range("G2:G" & ws.UsedRange.Rows.Count).SpecialCells(xlCellTypeVisible)
For Each rcell In rng.Cells

If InStr(1, rcell.Value, "1") > 0 Then
rcell.Offset(, 4).ClearContents
ElseIf InStr(1, rcell.Value, "2") > 0 Then
rcell.Offset(, 4).ClearContents
ElseIf InStr(1, rcell.Value, "14") > 0 Then
rcell.Offset(, 4).ClearContents
ElseIf InStr(1, rcell.Value, "26") > 0 Then
rcell.Offset(, 4).ClearContents
ElseIf InStr(1, rcell.Value, "34") > 0 Then
rcell.Offset(, 4).ClearContents
ElseIf InStr(1, rcell.Value, "37") > 0 Then
rcell.Offset(, 4).ClearContents
ElseIf InStr(1, rcell.Value, "39") > 0 Then
rcell.Offset(, 4).ClearContents
ElseIf InStr(1, rcell.Value, "40") > 0 Then
rcell.Offset(, 4).ClearContents
ElseIf InStr(1, rcell.Value, "63") > 0 Then
rcell.Offset(, 4).ClearContents
ElseIf InStr(1, rcell.Value, "64") > 0 Then
rcell.Offset(, 4).ClearContents
ElseIf InStr(1, rcell.Value, "66") > 0 Then
rcell.Offset(, 4).ClearContents
ElseIf InStr(1, rcell.Value, "111") > 0 Then
rcell.Offset(, 4).ClearContents
ElseIf InStr(1, rcell.Value, "915") > 0 Then
rcell.Offset(, 4).ClearContents
ElseIf InStr(1, rcell.Value, "1371") > 0

Tried using Select Case with InStr but that did the same.

UPDATE

If cell G2 = 1,2,14,37,39,63,111,601,915,1371,2533 then it should delete data in cell K2 because it contains one of the numbers stated.

Upvotes: 0

Views: 82

Answers (3)

Ryan Wildry
Ryan Wildry

Reputation: 5677

Here's yet another approach. I'm using a dictionary to look up values quickly,also, this method builds up a range via Union so I can call ClearContents in one shot. This may be a preferred method, if you have a lot of data to do this operation on. 

Option Explicit

Public Sub FindMatches()
    Dim SearchRange     As Range
    Dim Cell            As Range
    Dim ws              As Worksheet
    Dim MatchList       As Object
    Dim UnionRange      As Range

    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set SearchRange = ws.Range("G2:G" & ws.UsedRange.Rows.Count).SpecialCells(xlCellTypeVisible)
    Set MatchList = CreateMatchDictionary()

    For Each Cell In SearchRange.Cells
        If ContainsMatch(Cell, MatchList) Then
            If UnionRange Is Nothing Then
                Set UnionRange = Cell
            Else
                Set UnionRange = Union(Cell, UnionRange)
            End If
        End If
    Next

    If Not UnionRange Is Nothing Then UnionRange.Offset(0, 4).ClearContents

End Sub

Public Function CreateMatchDictionary() As Object
    Set CreateMatchDictionary = CreateObject("Scripting.Dictionary")
    With CreateMatchDictionary
        .Add "1", "1"
        .Add "2", "2"
        .Add "14", "14"
        .Add "37", "37"
        .Add "39", "39"
        .Add "63", "63"
        .Add "111", "111"
        .Add "601", "601"
        .Add "915", "915"
        .Add "1371", "1371"
        .Add "2533", "2533"
    End With
End Function

Public Function ContainsMatch(Cell As Range, dict As Object) As Boolean
    Dim CellValues As Variant
    Dim i          As Long

    ContainsMatch = False
    CellValues = Split(Cell.Value2, ",")

    For i = LBound(CellValues) To UBound(CellValues)
        If dict.Exists(CellValues(i)) Then
            ContainsMatch = True
            Exit Function
        End If
    Next

End Function

Upvotes: 0

TinMan
TinMan

Reputation: 7759

As Matt mentioned using Instr) can lead to false positives. It would be est to split the values. I recommend writing a function for any complex validations. This makes the code much easier to test and modify.

Function ContainsNumber(Values As String, ParamArray NumberList() As Variant) As Boolean
    Dim Item As Variant
    Dim MatchList As Variant
    MatchList = Split(Values, ",")

    For Each Item In NumberList
        If Not IsError(Application.Match(CStr(Item), MatchList, 0)) Then
            ContainsNumber = True
            Exit Function
        End If
    Next
End Function

Refactored Code

On Error Resume Next
Set Rng = ws.Range("G2:G" & ws.UsedRange.Rows.Count).SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Rng Is Nothing Then Exit Sub

For Each rcell In Rng.Cells

    If ContainsNumber(rcell.Value, 1, 2, 14, 26, 34, 37, 39, 40, 63, 64, 66, 111, 915, 1371) Then
        rcell.Offset(, 4).ClearContents
    End If

Next

Upvotes: 0

Siddharth Rout
Siddharth Rout

Reputation: 149295

Instr will give a partial match. It returns the position of the first occurrence of one string within another. To get an exact match use =

For example rcell.Value = 1 and so on...

If rcell.Value = 1 Or rcell.Value = 2 Or rcell.Value = 14... AND SO ON Then
    rcell.Offset(, 4).ClearContents
End If

or use Select Case as shown below

Select Case rcell.Value
    Case 1, 2, 14, 26, 34, 37, 39, 40, 63, 64, 66, 111, 915, 1371
        rcell.Offset(, 4).ClearContents
End Select

EDIT:

If cell G2 = 1,2,14,37,39,63,111,601,915,1371,2533 then it should delete data in cell K2 because it contains one of the numbers stated.

Based on the new edit in the question...

As @MathieuGuindon suggested split the content of the cell and then check for the code.

Try this (untested)

Dim Ar As Variant

Ar = Split(rcell.Value, ",")

For i = LBound(Ar) To UBound(Ar)
    Select Case Trim(Ar(i))
        Case 1, 2, 14, 26, 34, 37, 39, 40, 63, 64, 66, 111, 915, 1371
            rcell.Offset(, 4).ClearContents
            Exit For
    End Select
Next i

Upvotes: 1

Related Questions