Hello,
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,
Excel VBA Course - From Beginner to Expert
200+ Video Lessons
50+ Hours of Video
200+ Excel Guides
Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)
Find Values
0
Discussion
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: 4889) 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: 16) Sep 27, '17 at 2:31 am
Hello,
I changed the attached file in order to be more clear.
thank you,
I changed the attached file in order to be more clear.
thank you,
sebas14 (rep: 16) Sep 27, '17 at 5:40 am
Answers
0
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
NopOptions
NopFound = 5 ' = column E
NopNotFound
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")