Excel VBA Comparing 2 Alphanumeric Strings

[rookie2145]

I've written some code to compare two strings in the same worksheet. The code should check to see if the string in column b appears anywhere in column a. If the string is present in column a then a value of 'yes' should be returned. If the string isn't present then 'no' should be returned. An example of the strings would be 'SR03SN56' The SR and SN will always be present, only the numerical values will change. The code I have written is always returning 'Yes' or 'No' irrespective of whether the string is present in column a or not. I can't work out why although I have a feeling it's my use of the strcomp function. This needs to be done without using the vlookup function as it all needs to be contained within a macro.

<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, sans-serif; white-space: inherit;">Public Sub NameLater()
Dim colA As String, colB As String
Dim LastRowA As Integer, LastRowB As Integer, i As Integer, j As Integer
Dim Comparison As Integer
Dim Result As String

With ActiveSheet
LastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With ActiveSheet
LastRowB = .Cells(.Rows.Count, "B").End(xlUp).Row
End With


For i = 1 To LastRowA
For j = 2 To LastRowB



colA = Range("A" & i).Value
colB = Range("B" & j).Value

Comparison = StrComp(colA, colB, 1)

If Comparison = 1 Then Result = "Yes"
If Comparison = 0 Then Result = "No"
If Comparison = -1 Then Result = "No"

Sheet2.Range("H" & j).Value = Result

Next j

Next i

End Sub</code>

 

[Akuini]

Try this:

Sub aDup1()
Dim d As Object
Dim r As Range
Dim x
Dim i As Long
Dim s As String

Set d = CreateObject("scripting.dictionary")
d.CompareMode = vbTextCompare

For Each r In Range("B2", Cells(Rows.count, "B").End(xlUp))
    s = Trim(r.Value)
    If Not d.Exists(s) Then
    d(s) = 1
    End If
Next

i = 1
For Each r In Range("A2", Cells(Rows.count, "A").End(xlUp))
    s = Trim(r.Value)
    i = i + 1
    If d.Exists(s) Then
    sheets("sheet2").Cells(i, "H") = "YES"
    Else
    sheets("sheet2").Cells(i, "H") = "NO"
    End If
Next