Compare strings in 2 columns and match 80% - excel

Question

I have a macro which compares the first 20 characters of strings in two columns, when the customer type is "O" and gives the results. But I need to compare these two columns and if 80% of the strings match, i need to get the result as "ok" else "check". Can someone help me with correcting my code. Thanks
Sub Macro1()
'
'Match Organization names only the first 20 characters
'
'
Dim sht As Worksheet
Dim LR As Long
Dim i As Long
Dim str As String, str1 As String
Set sht = ActiveWorkbook.Worksheets("ORD_CS")
LR = sht.UsedRange.Rows.Count
With sht
For i = 8 To LR
If CStr(.Range("Q" & i).Value) = "O" Then
str = Left(.Range("S" & i).Value, 20)
str1 = Left(.Range("U" & i).Value, 20)
If str = str1 Then
Range("V" & i).Value = "ok"
Else
Range("V" & i).Value = "check"
End If
End If
Next i
End With
End Sub

Answer 1

Maybe use len() and multiply by .8
Sub Button1_Click()
Dim LstRw As Long, Rng As Range, sh As Worksheet, c As Range
Set sh = Sheets("ORD_CS")
With sh
LstRw = .Cells(.Rows.Count, "S").End(xlUp).Row
Set Rng = .Range("S2:S" & LstRw)
For Each c In Rng.Cells
If InStr(1, c.Offset(, 2), Left(c, Len(c) * 0.8)) Then
c.Offset(, 3) = "Yep"
Else: c.Offset(, 3) = "Nope"
End If
Next c
End With
End Sub
Compare column s or t whichever string is smaller.
You can count the string characters to find out which one is smaller.
Sub Button1_Click()
Dim LstRw As Long, Rng As Range, sh As Worksheet, c As Range
Set sh = Sheets("ORD_CS")
With sh
LstRw = .Cells(.Rows.Count, "S").End(xlUp).Row
Set Rng = .Range("S2:S" & LstRw)
For Each c In Rng.Cells
x = IIf(Len(c) < Len(c.Offset(, 1)), 0, 1)
If InStr(1, .Cells(c.Row, "U"), Left(c.Offset(, x), Len(c.Offset(, x)) * 0.8)) Then
.Cells(c.Row, "V") = "Yep"
Else: .Cells(c.Row, "V") = "Nope"
End If
Next c
End With
End Sub

Answer 2

Just keep track of the number of hits and divide that by the total rows you are looking at:
Sub Macro1()
'
'Match Organization names only the first 20 characters
'
'
Dim sht As Worksheet
Dim LR As Long
Dim i As Long
Dim str As String, str1 As String
Dim totalRows as Long, Dim matchRows as Long
Set sht = ActiveWorkbook.Worksheets("ORD_CS")
LR = sht.UsedRange.Rows.Count
totalRows = LR-8
With sht
For i = 8 To LR
If CStr(.Range("Q" & i).Value) = "O" Then
str = Left(.Range("S" & i).Value, 20)
str1 = Left(.Range("U" & i).Value, 20)
If str = str1 Then
Range("V" & i).Value = "ok"
matchRows = matchRows + 1
Else
Range("V" & i).Value = "check"
End If
End If
Next i
End With
'heres ther percentage of hits:
if matchRows/totalRows > .8 Then
msgbox "OK"
else
msgbox "Check"
End if
End Sub
If it's not 80% of the total matching rows you are looking for, but rather comparing to strings to get a number of how aproximately matched they are, you could implement the Levenshtein distance function and do your compare using that. See here for a VBA function that will do that which should be easy to implement in your code