I am new to StackOverflow, apologies in advance if I am not going about this in the right way.

I have some raw data that looks like the following:

All the values are separated by commas, in this string I am looking to find if the full range of numbers (1,2,3,4,5) is found, if it does, then it should return a 100% match.

In case only 4 numbers out of this range are found then it should return 80%, for 3 numbers 60%, for 2 numbers 40%, for 1 number 10% and in case none are found it should return "none". (see desired output below)

I am still new to VBA, but my thought was to split my comma separated values into an array, and then try to find a match. However unfortunately I already got stuck at the first match (i.e. finding 100%).

Sub CheckNumberMatches()

Dim i As Long
Dim Elem As Variant
Dim myArr As Variant

With Worksheets("data")
    For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
        myArr = Split(.Range("A" & i).Value, ",")

        ' loop through array elements and look for 1,2,3,4,5
        For Each Elem In myArr
            If Elem Like "1,2,3,4,5" Then
                .Range("B" & i).Value = "100%"
                Exit For
            End If
        Next Elem

    Next i
End With

End Sub

After @FunThomas his reply, I realize my requirements are not very clear, let me provide a few more examples of what can happen:

• The main criteria is (1,2,3,4,5) needs to be found in the cell, but this does not need to be in numerical order, i.e. can be random (2,4,1,3,5). If all these numbers are found in any order it should be 100%.
• If for example all five numbers are found (1,2,3,4,5) in the cell, but the cell also includes other numbers (1,2,3,4,5,6,7) - it should still be counted as 100%.
• If for example only four numbers of the main criteria are found (for example: 1,2,4,5) it should be considered as 80% (as long as 4 out of main numbers are found), likewise for 3, 2, 1 and 0 matches.
• The data can have gaps, i.e. it can be a range of (5,2,7,11,12), in this particular example it should be counted as 40% (2 out of 5 choices are found).
• Duplicate numbers are not possible.

I hope that clarifies.

CodePudding user response：

You started off well for your code. There are many ways something like this can be done. I've done up a simple way for you utiziling your code already. Have a look below and see if it's right for you.

I used Select Case as it allows to check for multiple things a lot easier than an If statement. You can even use ranges like Case 1 To 10. You can also do multiple Case lines to have different results do different things (like an ElseIf) etc.

Sub CheckNumberMatches()

Dim i As Long, Elem As Variant, myArr As Variant, Counter As Long

With Worksheets("data")
    For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
        myArr = Split(.Range("A" & i).Value, ",")
        Counter = 0
        ' loop through array elements and look for 1,2,3,4,5
        For Each Elem In myArr
            Select Case Elem
                Case 1, 2, 3, 4, 5
                    Counter = Counter   1
            End Select
        Next
        If Counter > 0 Then
            .Cells(i, "B").Value = Format(Counter / 5, "0%")
        Else
            .Cells(i, "B").Value = "None"
        End If
    Next i
End With

End Sub

CodePudding user response：

Array approach

Instead of looping through each cell in column "A" which can be time consuming, you can benefit from using arrays:

• Assign data to 1-based 2-dim data field array (see section 3),

• analyze each splitted element cur in a single loop (section 4), where counting the result of Match() with two array inputs receives the wanted information in one go via

  Application.Count(Application.Match(cur, base, 0))

  Note that Application.Count() neglects errors resulting from non-findings.

• All infos are reassigned to the data array and written back via rng.Offset(, 1) = data

Sub FoundBaseNumbers()
With Tabelle1
'1. Assign needed base numbers to 1-dim array
    Dim base As Variant: base = Split("1,2,3,4,5", ",")
'2. Define data range
    Dim lastRow As Long
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    Dim rng As Range
    Set rng = .Range("A1:A" & lastRow)
'3. Assign data to 1-based 2-dim data field array
    Dim data As Variant: data = rng.Value2
'4. Analyze data
    Dim i As Long, cur As Variant, cnt As Long
    For i = 1 To UBound(data)
    'a) count findings of current elements
        cur = Split(data(i, 1), ",")
        cnt = Application.Count(Application.Match(cur, base, 0))
    'b) remember percentages using data field array
        data(i, 1) = IIf(cnt, Format(cnt / (UBound(base)   1), "0%"), "None")
    Next i
'5. Write data to neighbour column
    rng.Offset(, 1) = data
End With
End Sub