Reputation: 35
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
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
Upvotes: 1