Excel VBA: Find cells with similar values in a column

Question

I have in column A multiple strings of numbers that look like:

2222222266622222266666222222222222266622666666222 2222266666622222222666662222666222222666222222222 2222266622226666662266622266622222222222222222666 2222222222222666222226662266622226666622222222666 2666662266622222222222222222222666222222666222666 2222266622222666666666662266622222222222222222222 6662266622226662222266622222666222222266622222222 2666622666666222666222222666222222222222222222222 2222266626662666222222266622222222222666222266622 and so on.

I'm trying to find the values that are 90% the same or another percentage that I would choose before I run the program.

The expected result should be in column B how many other cells would share the same structure as much as an percentage with column A, and if it is possible in next column or columns, the cells that gave that similitude

My first try:

Sub Similar()
Dim stNow As Date
Dim DATAsheet As Worksheet
Dim firstrow As Integer
Dim finalrow As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim String_i, Len_i, String_j, Len_j
stNow = Now
   Application.EnableEvents = False
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
Set DATAsheet = Sheet1
DATAsheet.Select
firstrow = Cells(1, 2).End(xlDown).Row
finalrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = firstrow To finalrow
  For j = firstrow To finalrow
    If i > 3 And j > 3 And i <> j Then
      String_i = Cells(i, 1).Value
      Len_i = Len(String_i)
      String_j = Cells(j, 1).Value
      Len_j = Len(String_j)
        For k = 1 To Len_i
         For l = 1 To Len_j
          If Mid(String_i, k, 1) = Mid(String_j, l, 1) Then
           Cells(j, 2).Value = Cells(j, 2).Value + 1
          End If
         Next l
        Next k
     End If
       DoEvents
   Next j
   Application.StatusBar = "Loop 1/1 --- Done:   " & Round((i / finalrow * 100), 0) & " %"
Next i
Application.StatusBar = ""
MsgBox "Done"
   Application.EnableEvents = True
   Application.ScreenUpdating = True
   Application.Calculation = xlCalculationAutomatic
End Sub

But it gaves me in column B the results:

259461.00 262794.00 262794.00 262794.00 259461.00 266123.00 259461.00 259461.00

Any help is appreciated.

Thanks!!!

question from:https://stackoverflow.com/questions/65862818/excel-vba-find-cells-with-similar-values-in-a-column

Answer 1

VladMale first we will need lengt of this string - function LEN, and then we will need comparing substrings - function MID. Second function should be made in some loop from first to last character in a string, and every time it will match, some other cell should count how many times it mached and how many not. The posivite result we can divide by the string length * 100 and compare if it is more or less than 90%