Compare Values In One Column With Values In 3

[Closed]
Report
-
 jama -
Hello,

I need to compare values from one column A, with a group of values in 3 other short columns that contain fixed values, O2:O19, P2:P19 and Q2.

If the value in column A matches a value from column range O2:O19 then it needs to return the value 1, if the value in column A matches a value from column range P2:P19 then it needs to return the value 10 and if the value in column A matches the value from Q2 then it needs to return the value 100

Hope someone can help me out on this

Jama

4 replies

Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
801
SAVE YOUR FILE SAFELY SOMEWHERE SO THAT YOUR DATA IS NOT MESSED UP DUE TO THIS MACRO


in columnA the data is form A2 down and A1 is the column heading.
then try this macro (modify to suit you)

Sub test()
Dim ro As Range, rp As Range, rq As Range, ra As Range
Dim c As Range, x, cfind As Range
Set ra = Range(Range("A2"), Range("A2").End(xlDown))
Set ro = Range("O2:O19")
Set rp = Range("P2:P19")
Set rq = Range("Q2")
For Each c In ra
x = c.Value
If Not ro.Cells.Find(what:=x, lookat:=xlWhole) Is Nothing Then
c = 1
ElseIf Not rp.Cells.Find(what:=x, lookat:=xlWhole) Is Nothing Then
c = 10
ElseIf Not rq.Cells.Find(what:=x, lookat:=xlWhole) Is Nothing Then
c = 100
End If
Next c


End Sub
Thanks for this, my Excel knowledge is quite limited so I am unsure how to modify this to suit my needs. I don't see how it outputs the data, or where to!

Just to try and clarify, the original column I am carrying out the compare on, col A, will have values entered. As the values are entered I want the compare to be carried out and the result value to be entered in the adjacent cell in col B.

Jama
Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
801
In your first message you said
quote
f the value in column A matches a value from column range O2:O19 then it needs to return the value 1,
unquote
you did not say that it should be returned in adjacent cell in column B ok try this macro. I have not tested. confirm if it is ok

<code>Sub test()
Dim ro As Range, rp As Range, rq As Range, ra As Range
Dim c As Range, x, cfind As Range
Set ra = Range(Range("A2"), Range("A2").End(xlDown))
Set ro = Range("O2:O19")
Set rp = Range("P2:P19")
Set rq = Range("Q2")
For Each c In ra
x = c.Value
If Not ro.Cells.Find(what:=x, lookat:=xlWhole) Is Nothing Then
c.Offset(0, 1) = 1
ElseIf Not rp.Cells.Find(what:=x, lookat:=xlWhole) Is Nothing Then
c.Offset(0, 1) = 10
ElseIf Not rq.Cells.Find(what:=x, lookat:=xlWhole) Is Nothing Then
c.Offset(0, 1) = 100
End If
Next c


End Sub
</code
Thanks again venkat.

I appreciate it might not have been clear in the original post, hence the clarification.

When I run the macro that works great and all values appear to be entered correctly from what I have checked. It is a bit slow and makes the screen 'shudder' as it updates. I could probably live with that but it is not 100% how I want it to be executed.

I need the compare to happen at the time data is entered. Running the macro manually after every single piece of data is entered is something I can't do.

I appreciate your help with this.


Jama
Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
801
right click sheet tab and click "view code". in the window that comes up copy paste this EVENT CODE.

what happens is as soon as you enter any number in any cell in range A2 down automatically if that number is found either in O2 to O12, P2 to P12 or in Q2 a number will come up in the same row in column B depending upon in which range it is found. check putting a few numbers.
confirm whether this is ok or there is any bug.
if there is bug post at which statement the code stops or misbehaves and also the error message.
the EVENT CODE is

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ro As Range, rp As Range, rq As Range, x

With Application
.EnableEvents = False
.ScreenUpdating = False

If Err.Number <> 0 Then
MsgBox "some error has come up" & Err.Number
GoTo exiting
End If
If Target.Column <> 1 Then GoTo exiting
If Target.Address = "$A$1" Then GoTo exiting
If Target = "" Then GoTo exiting
'Set ra = Range(Range("A2"), Range("A2").End(xlDown))
Set ro = Range("O2:O19")
Set rp = Range("P2:P19")
Set rq = Range("Q2")
'For Each c In ra
x = Target.Value
If Not ro.Cells.Find(what:=x, lookat:=xlWhole) Is Nothing Then
Target.Offset(0, 1) = 1
ElseIf Not rp.Cells.Find(what:=x, lookat:=xlWhole) Is Nothing Then
Target.Offset(0, 1) = 10
ElseIf Not rq.Cells.Find(what:=x, lookat:=xlWhole) Is Nothing Then
Target.Offset(0, 1) = 100
End If
exiting:
.EnableEvents = True
.ScreenUpdating = True
End With 'application

End Sub

This works venkat.

The only time I get an error is when I delete a full block of the test data in one go. ie A381:A401.

I get,

"Run-time error '13': Type mismatch"

If I select 'End' nothing else happens, any subsequent data entry does not run the event and no data is entered in column B.

If I select 'debug' then this portion of code is highlighted If Target = "" Then

It is not a real problem the ay it is now. I can delete these items one at a time and I get no errors, so I can always do that if I ever need to. I then just need to delete the data from column B also but this really isn't a problem to do either, whatever is in column B when the column A data is deleted remains, until new data in A is entered.

Thanks again venkat
Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
801
you have written
quote
I need the compare to happen at the time data is entered.
unquote
then how the entries are made already.
you could have deleted the data BEFORE copying the event code
other wise you can use this slightly modified code . Park it as instructed before
USE WHICHEVER SUITS YOU


Private Sub Worksheet_Change(ByVal Target As Range)
Dim ro As Range, rp As Range, rq As Range, x

on error goto exiting 

If Err.Number <> 0 Then
MsgBox "some error has come up" & Err.Number
GoTo exiting
End If
If Target.Column <> 1 Then GoTo exiting
If Target.Address = "$A$1" Then GoTo exiting
If Target = "" Then GoTo exiting
'Set ra = Range(Range("A2"), Range("A2").End(xlDown))
Set ro = Range("O2:O19")
Set rp = Range("P2:P19")
Set rq = Range("Q2")
'For Each c In ra
x = Target.Value
If Not ro.Cells.Find(what:=x, lookat:=xlWhole) Is Nothing Then
Target.Offset(0, 1) = 1
ElseIf Not rp.Cells.Find(what:=x, lookat:=xlWhole) Is Nothing Then
Target.Offset(0, 1) = 10
ElseIf Not rq.Cells.Find(what:=x, lookat:=xlWhole) Is Nothing Then
Target.Offset(0, 1) = 100
End If
exiting:
.EnableEvents = True
.ScreenUpdating = True
End With 'application

End Sub


Thanks venkat. As I said, the errors I was experiencing is not a problem.

The 'code' just doesn't allow for a batch of incorrect data being entered and deleted. As it's is only me that will be entering data and I know about the limitations of the code, I can handle it and will work around it.

I appreciate all your help with this.

Jama