Validate cells in column A with info from other columns

[Shywawa]

Hi,

I am trying to validate with OK/CHECK values from column A. The result goes into column B for each value in Row A.
The values I am trying to do the validation come from 2 different columns ( G and H).

For Example:

Column A has a variety of Last Name + First Name combinations written in all possible forms (John Deer; Deer, John; Deer John; Acapulco hotel Deer John)
Columns G and H are first Name Last Name of the people that are valid and which i need to do the validation for. needles to say these 2 need to be from the same row.

The code i wrote so far is the one below but unfortunately the result is CHECK from top to bottom. I have a feeling i am doing something very wrong with the info coming from G and H.



Sub Match()

Dim cell As Range


For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeConstants)

If InStr(Cells(cell.Row, "A"), Cells(cell.Column, "H")) > 0 And _
InStr(Cells(cell.Row, "A"), Cells(cell.Column, "I")) > 0 Then


Cells(cell.Row, "B") = "OK"

Else

Cells(cell.Row, "B") = "Check"


End If
Next cell


End Sub





Let me know if you need a sample of the file.

Kind regards,
Shywawa

[mancubus]

post your workbook pls.

[georgiboy]

Hi there

I am on my phone so can’t test code but looking at this I would ask:

Does the function Instr require values of a cell or a string to look at?

The code above is passing the cell itself to Instr and may cause issues.

Hope this helps

[Shywawa]

Hi mancubus, attached.

Hi georgiboy, a string in a cell. I just want to make this validation and this was the idea I had before getting stuck.

21491

Thank you!
Shywawa

[Paul_Hossler]

Updated after attachment posted


Assuming I understood ....

21496




Option Explicit

Sub Match()
Dim rCell As Range

With ActiveSheet
For Each rCell In Range(.Cells(2, 1), .Cells(2, 1).End(xlDown)).Cells
'not case sensitive
If InStr(1, rCell.Value, .Cells(rCell.Row, 7), vbTextCompare) > 0 And InStr(1, rCell.Value, .Cells(rCell.Row, 8), vbTextCompare) > 0 Then
.Cells(rCell.Row, 2) = "OK"
Else
.Cells(rCell.Row, 2) = "Check"
End If
Next
End With
End Sub

[Shywawa]

Hi Paul,

My code was producing similar hits if the names were on the same row. Unfortunately if you sort AtoZ or ZtoA in G or H the macro won't work anymore.
Sadly the file i am using has a lot more names in column G and H and it needs to work independently of the row where the values are. Attached a screenshot from the file you posted with a simple sort.

21499

Please advise.


Kind regards,
DD

[Paul_Hossler]

Column A has a variety of Last Name + First Name combinations written in all possible forms (John Deer; Deer, John; Deer John; Acapulco hotel Deer John)
Columns G and H are first Name Last Name of the people that are valid and which i need to do the validation for. needles to say these 2 need to be from the same row.


I misunderstood 'same row'

Anyways, it's easy enough



Option Explicit

Sub Match()
Dim rCell As Range
Dim aNames As Variant
Dim r As Long

With ActiveSheet

aNames = .Cells(1, 7).CurrentRegion.Value

For Each rCell In Range(.Cells(2, 1), .Cells(2, 1).End(xlDown)).Cells
.Cells(rCell.Row, 2) = "Check"

For r = LBound(aNames, 1) + 1 To UBound(aNames, 1)
'not case sensitive
If InStr(1, rCell.Value, aNames(r, 1), vbTextCompare) > 0 And InStr(1, rCell.Value, aNames(r, 2), vbTextCompare) > 0 Then
.Cells(rCell.Row, 2) = "OK"
Exit For
End If
Next r
Next
End With
End Sub




However, since InStr is used, there is chance for error. A better solution will be more complicated


21501

[georgiboy]

There is probably a much simpler way of doing this but thought i would post my best attempt:


Function removeSpecial(sInput As String) As String Dim sSpecialChars As String
Dim i As Long
sSpecialChars = ",;"
For i = 1 To Len(sSpecialChars)
sInput = Replace$(sInput, Mid$(sSpecialChars, i, 1), "")
Next
removeSpecial = sInput
End Function


Sub SearchNames()
Dim FstLstRng As Range, rCell As Range, CheckCells As Range
Dim NameList As Variant, Nme As Variant
Dim Str As String, a As Long, b As Long, c As Long

Set FstLstRng = Range("G2:H" & Range("G" & Rows.Count).End(xlUp).Row).Cells
Set CheckCells = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Cells

NameList = FstLstRng

For Each rCell In CheckCells.Cells
rCell.Offset(, 1).Value = "CHECK"
Str = removeSpecial(rCell.Value)
Nme = Split(Str, " ")
For a = 0 To UBound(Nme)
For b = 1 To UBound(NameList)
If UCase(Nme(a)) = UCase(NameList(b, 1)) Then
For c = 0 To UBound(Nme)
If UCase(Nme(c)) = UCase(NameList(b, 2)) Then
rCell.Offset(, 1).Value = "OK"
Exit For
End If
Next c
End If
Next b
Next a
For a = 0 To UBound(Nme)
For b = 1 To UBound(NameList)
If UCase(Nme(a)) = UCase(NameList(b, 2)) Then
For c = 0 To UBound(Nme)
If UCase(Nme(c)) = UCase(NameList(b, 1)) Then
rCell.Offset(, 1).Value = "OK"
Exit For
End If
Next c
End If
Next b
Next a
Next rCell
End Sub

May need to add some more special characters

Hope this helps

[Shywawa]

Hi Paul,

Thank you for the code. This will work, I am aware it might backfire on a few names but it should be ok. My next step will be to add the names that came from the OK check in the next column.
If you have any idea let me know. I will mark this thread as solved later on today.


Hi Georgiboy,

I ran your code also but it only gave Check from top to bottom.


Thank you both very much for the help on this one.


Kind regards,
Shywawa

[georgiboy]

How strange, here is the file i used to test:

21504

[Shywawa]

How strange, here is the file i used to test:

21504

This is working!

Thank you for the code! If you have any idea on how to put the matching names next to the validation (next column) please shoot!
I will crunch my brains on it today and if I can't find anything will open a new thread. Or should I keep this one open and update the name?

[georgiboy]

Maybe:


Function removeSpecial(sInput As String) As String
Dim sSpecialChars As String
Dim i As Long
sSpecialChars = ",;"
For i = 1 To Len(sSpecialChars)
sInput = Replace$(sInput, Mid$(sSpecialChars, i, 1), "")
Next
removeSpecial = sInput
End Function

Sub SearchNames()
Dim FstLstRng As Range, rCell As Range, CheckCells As Range
Dim NameList As Variant, Nme As Variant
Dim Str As String, a As Long, b As Long, c As Long

Set FstLstRng = Range("G2:H" & Range("G" & Rows.Count).End(xlUp).Row).Cells
Set CheckCells = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Cells

NameList = FstLstRng

For Each rCell In CheckCells.Cells
rCell.Offset(, 1).Value = "CHECK"
Str = removeSpecial(rCell.Value)
Nme = Split(Str, " ")
For a = 0 To UBound(Nme)
For b = 1 To UBound(NameList)
If UCase(Nme(a)) = UCase(NameList(b, 1)) Then
For c = 0 To UBound(Nme)
If UCase(Nme(c)) = UCase(NameList(b, 2)) Then
rCell.Offset(, 1).Value = NameList(b, 1)
rCell.Offset(, 2).Value = NameList(b, 2)
Exit For
End If
Next c
End If
Next b
Next a
For a = 0 To UBound(Nme)
For b = 1 To UBound(NameList)
If UCase(Nme(a)) = UCase(NameList(b, 2)) Then
For c = 0 To UBound(Nme)
If UCase(Nme(c)) = UCase(NameList(b, 1)) Then
rCell.Offset(, 1).Value = NameList(b, 1)
rCell.Offset(, 2).Value = NameList(b, 2)
Exit For
End If
Next c
End If
Next b
Next a
Next rCell
End Sub

[Shywawa]

Perfect!

:bow:

Thank you all for the help!