Conditioning the names in a cell

[AleemAM123]

Hi Everyone,

I need to look up the name of a person in one sheet (sheet1) against a name in another sheet (sheet2) and where the names match return a value from an adjacent cell in sheet2. I have been able to do that but I am running into a problem when the name in sheet1 was not spelt properly. I have to copy and paste the names from other excel files to sheet1, I have no control over the other excel files (they are sent from other users). The errors in the spelling may be an extra space at the end of the name, a missing comma, no space after the comma and rarely a typo. The names in sheet 2 can be taken as correct, is there any way to correct the names in sheet1 using VB or take the data from the closest match in sheet2?

P.S. I realise there is a lot of room for improvement in my code so if you see anything that needs fixing, you can point it out to me. I would appreciate that a lot. Thanks.:dunno

[ranman256]

Not that I know of. (30 year programmer) I'd say manual fix is the only way.

[snb]

Sub M_snb()
sn = Sheet1.Columns(4).SpecialCells(2)
sp = Sheet2.Columns(3).SpecialCells(2)

For j = 1 To UBound(sn)
sn(j, 1) = Replace(Replace(sn(j, 1), ",", ""), " ", "")
Next

For j = 1 To UBound(sp)
sp(j, 1) = Replace(Replace(sp(j, 1), ",", ""), " ", "")
Next

For j = 1 To UBound(sn)
c00 = "not found"
If Not IsError(Application.Match(sn(j, 1), sp, 0)) Then c00 = "found in position " & Application.Match(sn(j, 1), sp, 0)
MsgBox c00
Next
End Sub

[mikerickson]

The formula =TRIM(SUBSTITUTE(A1, ",", " "))
(note the space in the third argument)
will eliminate leading and trailing spaces, convert commas to spaces and remove duplicate spaces
So both "Smith, John" and "Smith,John " will both become "Smith John" making it easier to compare.

[Paul_Hossler]

I'd do it something like this

I used arrays to hold the 'clean' names by removing spaces, commas, etc. You can expand to remove other characters that might cause issues (Smith, John Jr. vs Smith John Jr)






Option Explicit
Sub AAM_PROCABS()
Dim i As Long, j As Long ' -- each variable must be specifically typed, otherwise it's Variant
Dim opName As String, checkName As String, listSection As String, listJob As String
Dim wsLookIn As Worksheet, wsPutHere As Worksheet
Dim aLookInNames As Variant, aPutHereNames As Variant
Set wsPutHere = Worksheets("Sheet1")
Set wsLookIn = Worksheets("Sheet2")
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
aLookInNames = Application.WorksheetFunction.Transpose(wsLookIn.Cells(1, 1).CurrentRegion.Columns(3))
aPutHereNames = Application.WorksheetFunction.Transpose(wsPutHere.Cells(1, 1).CurrentRegion.Columns(4))
For i = LBound(aLookInNames) To UBound(aLookInNames)
aLookInNames(i) = UCase(aLookInNames(i))
Do While InStr(aLookInNames(i), ",") > 0
aLookInNames(i) = Replace(aLookInNames(i), ",", vbNullString)
Loop
Do While InStr(aLookInNames(i), " ") > 0
aLookInNames(i) = Replace(aLookInNames(i), " ", vbNullString)
Loop
Next i
For i = LBound(aPutHereNames) To UBound(aPutHereNames)
aPutHereNames(i) = UCase(aPutHereNames(i))
Do While InStr(aPutHereNames(i), ",") > 0
aPutHereNames(i) = Replace(aPutHereNames(i), ",", vbNullString)
Loop
Do While InStr(aPutHereNames(i), " ") > 0
aPutHereNames(i) = Replace(aPutHereNames(i), " ", vbNullString)
Loop
Next i
For i = LBound(aPutHereNames) To UBound(aPutHereNames)
j = -1
On Error Resume Next
j = Application.WorksheetFunction.Match(aPutHereNames(i), aLookInNames, 0)
On Error GoTo 0
If j > -1 Then
wsPutHere.Cells(i, 1).Value = wsLookIn.Cells(j, 2).Value
wsPutHere.Cells(i, 2).Value = wsLookIn.Cells(j, 1).Value
End If
Next i

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

[snb]

To keep it simple and fast:


Sub M_snb()
c00 = "|" & Replace(Replace(Join(Application.Transpose(Sheet1.Columns(4).SpecialCells(2 )), "|"), ",", ""), " ", "") & "|"
sp = Split(Replace(Replace(Join(Application.Transpose(Sheet2.Columns(3).SpecialC ells(2)), "|~|"), ",", ""), " ", "") & "|", "~")

For j = 1 To UBound(sp)
MsgBox IIf(InStr(c00, sp(j)), "", "not ") & "found"
Next
End Sub

[AleemAM123]

Thanks everyone, this was so helpful. Paul and snb thank you so much for the code, I'd have never thought to write something like that.