ish
ish

Reputation: 35

search exact value of cell in a string

I have a description in Column A which contains some error code like ESFB-1 , ESFB-11 etc... with list of error codes in sheet2 a total of about 36 error codes

I have the below code written & works but the only problem is it is treating both ESFB-1 & ESFB-11 as same the list has about 35 error codes with similar nomenclature below is the code

enter code here
Sub sear()
Dim rng As Range
Dim str As String
Dim str1 As String
Dim val1 As Long
Dim val2 As Long
Dim col As Integer
Dim col2 As Integer
Dim row2 As Integer
Dim row As Integer
Dim var As Integer
Dim lastRow As Long
Dim lastrow1 As Long
Dim pos As Integer
lastRow = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).row
lastrow1 = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).row
var = 0
col = 1
row = 2
row2 = 2
pos = 0
Do While var <> 1
   Do While row <= lastrow1
       Do While pos = 0
           str = Sheets("Sheet1").Cells(row, 1).Value
           str1 = Sheets("Sheet2").Cells(row2, 1).Value
           pos = InStrRev(str, str1, vbTextCompare)
           row2 = row2 + 1
           If row2 = lastRow Then Exit Do
        Loop
        If pos <> 0 Then
        Cells(row, 7).Value = Sheets("Sheet2").Cells(row2 - 1, 1)
        End If
        Cells(row, 8).Value = pos & Sheets("Sheet1").Cells(row, 1)
        pos = 0
        row2 = 2
        row = row + 1
    Loop
var = 1
Loop
End Sub

Please suggest modifications which can help me find the exact error code from description

Upvotes: 2

Views: 84

Answers (1)

Siddharth Rout
Siddharth Rout

Reputation: 149335

Instr will give you false positive like you are getting for ESFB-1 & ESFB-11 and hence you need a more robust check.

Is this what you are trying?

Sub Sample()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lRow As Long
    Dim Arws As Variant, tempAr As Variant
    Dim rng As Range, aCell As Range
    
    '~~> Set your sheets here
    Set ws1 = Sheet1: Set ws2 = Sheet2
    
    With ws2
        lRow = .Range("A" & .Rows.Count).End(xlUp).row
        
        '~~> Store the error codes in an array
        Arws = .Range("A1:A" & lRow)
    End With
    
    With ws1
        lRow = .Range("A" & .Rows.Count).End(xlUp).row
        
        '~~> This is your range from 1st sheet
        Set rng = .Range("A2:A" & lRow)
        
        '~~> Loop through all cells and split it's contents
        For Each aCell In rng
            tempAr = Split(aCell.Value)
            '~~> Loop through each split word in the array
            For i = LBound(tempAr) To UBound(tempAr)
                '~~> Check if exists in array
                If ExistsInArray(Trim(tempAr(i)), Arws) Then
                    '~~> If it does then write to col B
                    aCell.Offset(, 1).Value = Trim(tempAr(i))
                    Exit For
                End If
            Next i
        Next aCell
    End With
End Sub

'~~> Function to check if a string is int he array
Function ExistsInArray(s As String, arr As Variant) As Boolean
    Dim bDimen As Byte, i As Long

    On Error Resume Next
    If IsError(UBound(arr, 2)) Then bDimen = 1 Else bDimen = 2
    On Error GoTo 0

    Select Case bDimen
    Case 1
        On Error Resume Next
        ExistsInArray = Application.Match(s, arr, 0)
        On Error GoTo 0
    Case 2
        For i = 1 To UBound(arr, 2)
            On Error Resume Next
            ExistsInArray = Application.Match(s, Application.Index(arr, , i), 0)
            On Error GoTo 0
            If ExistsInArray = True Then Exit For
        Next
    End Select
End Function

Screenshot

enter image description here

Upvotes: 1

Related Questions