Find Values



I need to determine if some values that i have in a cell are between the values of an entire line, and to differentiate those that are from those that are not (I attached a file for examplification).

Thank you,



Your requirement is far from clear. Perhaps you can add a sheet to your sample workbook which shows the result you you hope for. Where, in your sample sheet are the values you want to compare? What and where should be the result of the comparison?
Variatus (rep: 2354) Sep 26, '17 at 8:55 pm
if we look in the sample, I want to determine if the values which are in the cell B5 are in the range C5: AD5, and I would like to show the results in another cell of the line 5 (if possible A5)
sebas14 (rep: 4) Sep 27, '17 at 2:31 am
I changed the attached file in order to be more clear.
thank you,
sebas14 (rep: 4) Sep 27, '17 at 5:40 am
Add to Discussion


Selected Answer

Please paste the code below into a standard code module. Make sure you have a backup of your data before you run it.

Option Explicit
Enum Nop                                ' options
    ' where no value is assigned the value equals the previous + 1
    ' you can assign values to any enumeration to alter the automatic sequence
    NopFirstDataRow = 2                 ' modify as required
    NopTitle = 1                        ' = column A
    NopFound = 5                        ' = column E
    NopFirstOption = 7                  ' = column G (start of OptRng)
End Enum
Sub FindOptions()
    ' 28 Sep 2017
    Dim Opt() As String
    Dim OptRng As Range
    Dim Rslt() As String
    Dim Spike() As String
    Dim Tmp As String
    Dim Rl As Long, Cl As Long          ' last row / last column
    Dim R As Long
    Dim i As Long, j As Long
    With ActiveSheet
        Rl = .Cells(.Rows.Count, NopTitle).End(xlUp).Row
        ReDim Rslt(1 To Rl - NopFirstDataRow + 1, 1 To 2)
        For R = NopFirstDataRow To Rl
            On Error Resume Next
            Tmp = .Cells(R, NopOptions).Value
            If Err Then Tmp = ""
            On Error GoTo 0
            If Len(Tmp) Then
                ReDim Spike(1 To 2)
                Cl = .Cells(R, .Columns.Count).End(xlToLeft).Column
                Set OptRng = .Range(.Cells(R, NopFirstOption), .Cells(R, Cl))
                Opt = Split(Tmp)
                For i = 0 To UBound(Opt)
                    j = (1 - IsError(Application.Match(Opt(i), OptRng, 0)))
                    Spike(j) = Spike(j) & Opt(i) & " "
                Next i
                For j = 1 To 2
                    Rslt(R - NopFirstDataRow + 1, j) = Trim(Spike(j))
                Next j
            End If
        Next R
        Set OptRng = .Cells(NopFirstDataRow, NopFound).Resize(UBound(Rslt), UBound(Rslt, 2))
        OptRng.Value = Rslt
    End With
End Sub

Observe the enumeration at the top of the code. This is where you can change the columns and the first row, if necessary. Note that the code will run on the active sheet. I consider that danagerous and recommend that you change the code to run on a sheet you name in the code itself. Change "With ActiveSheet" into

With Worksheets("Attributs")
(or whatever the sheet's real name will be).


Great job ! Thanks a lot Variatus !
sebas14 (rep: 4) Sep 27, '17 at 10:26 am
Add to Discussion

Answer the Question

You must create an account to use the forum. Create an Account or Login