Compare data within same cell

[Psyanide]

I require a macro code which compares data within same cell and accordingly provides status either "match found" or "mismatch"
I work on a discrepancy report and most of the property addresses are same only difference is abbreviations
eg. street = st, Road = rd and so on.

In the below example data on left side of "|||" is from 1 source and data on right side of "|||" is from other source
In the below example "A2" and "A3" are good to be deleted however "A4" has "drive" against "avenue" hence it needs to be verified.
Can you please provide me a macro code which would give me output as presented in "B" column based on the data on column "A"

Note: There are many such abbreviations I come across which I will add in the code by myself once I have the basic code.

	A	B
1	Property Address	Macro result
2	Apple Street ||| Apple St	Delete
3	Blue Road colony ||| Blue Rd colony	Delete
4	Sunshine Drive ||| Sunshine Avenue	Check

<colgroup><col><col><col></colgroup><tbody>
</tbody>

Thanks

 

[wesborland1234]

Assuming they are all formatted like that (separated by the "| | |" and the longer name on the left), this will work:

Public Function address1(str As String) As String
    address1 = Left(str, Application.Find("|||", str) - 2)
End Function
 
Public Function address2(str As String) As String
    address2 = Right(str, Len(str) - Application.Find("|||", str) - 3)
End Function

Sub Button1_Click()
    Dim add1 As String
    Dim add2 As String
    Dim currRow As Long
    Dim maxRow As Long
    Dim address As String
    
    maxRow = 4 ' However many rows you have
    
    For currRow = 1 To maxRow
        address = Cells(currRow, 1).Value
        add1 = address1(address)
        add2 = address2(address)
        If LCase(add1) = Replace(LCase(add2), "st", "street") Then 'Do the same for road, rd, etc.
            Cells(currRow, 2).Value = "Delete"
        Else
            Cells(currRow, 2).Value = "Verify"
        End If
    Next
End Sub

 

[Psyanide]

This works thanks.
Only 1 small addition is required.
You are right with the assumption that data is always separated by the " ||| " sign.

However,

1 - The longer name could be on right and shorter name on left and vice versa.

2 - There could be more than one (2,3,4....) short and long names in an address e.g. "Apple Street Drive ||| Apple St Dr" or "Apple St Drive Road ||| Apple Street Dr Rd"......this is random.


Can you modify the code to handle these scenarios ?

 

[Psyanide]

I figured out the first scenario.

Please help me with the second scenario where the address is having more than one abbreviation.

Thanks

 

[wesborland1234]

Add this function:

Public Function replaceAll(str As String) As String
    str = Replace(str, "st", "street")
    str = Replace(str, "ave", "avenue")
    str = Replace(str, "rd", "road") 'Add as many of these as you want
    
    replaceAll = str
End Function

And then just change the if statement to this:

If LCase(add1) = replaceAll(LCase(add2)) Or LCase(add2) = replaceAll(LCase(add1)) Then

 

[Psyanide]

Little messed up with complaining all the code. Please assist what should be retained and what should be deleted from the final code........



Public Function address1(str As String) As String
address1 = Left(str, Application.Find("|||", str) - 2)
End Function

Public Function address2(str As String) As String
address2 = Right(str, Len(str) - Application.Find("|||", str) - 3)
End Function
Public Function replaceAll(str As String) As String
str = Replace(str, "st", "street")
str = Replace(str, "ave", "avenue")
str = Replace(str, "rd", "road") 'Add as many of these as you want

replaceAll = str
End Function


Sub Button1_Click()
Dim add1 As String
Dim add2 As String
Dim currRow As Long
Dim maxRow As Long
Dim address As String

maxRow = 4 ' However many rows you have

For currRow = 1 To maxRow
address = Cells(currRow, 1).Value
add1 = address1(address)
add2 = address2(address)
If LCase(add1) = replaceAll(LCase(add2)) Or LCase(add2) = replaceAll(LCase(add1)) Then 'Do the same for road, rd, etc.
Cells(currRow, 2).Value = "Delete"
Else
Cells(currRow, 2).Value = "Verify"
End If
Next
End Sub

 

[Psyanide]

I require solution for case 1

1- Apple Road St ||| Apple Rd Street	Verify
2- Apple St ||| Apple Street	Delete
3 - Apple Road ||| Apple Rd	Delete
4 - Apple Avenue ||| Apple Ave	Delete

<colgroup><col><col></colgroup><tbody>
</tbody>

 

[wesborland1234]

In order to handle that, change the replaceAll function to go from long names to short names, and then apply it to both sides in the if statement.

Full code:

Public Function address1(str As String) As String
    address1 = Left(str, Application.Find("|||", str) - 2)
End Function
 
Public Function address2(str As String) As String
    address2 = Right(str, Len(str) - Application.Find("|||", str) - 3)
End Function

Public Function replaceAll(str As String) As String
    str = Replace(str, "street", "st")
    str = Replace(str, "avenue", "ave")
    str = Replace(str, "road", "rd") 'Add as many of these as you want
    
    replaceAll = str
End Function

Sub Button1_Click()
    Dim add1 As String
    Dim add2 As String
    Dim currRow As Long
    Dim maxRow As Long
    Dim address As String
    
    maxRow = 5 ' However many rows you have
    
    For currRow = 1 To maxRow
        address = Cells(currRow, 1).Value
        add1 = address1(address)
        add2 = address2(address)
        If replaceAll(LCase(add1)) = replaceAll(LCase(add2)) Then
            Cells(currRow, 2).Value = "Delete"
        Else
            Cells(currRow, 2).Value = "Verify"
        End If
    Next
End Sub

 

[Psyanide]

Thanks a lot This is very helpful.

 

[Psyanide]

Hi there,

I am facing a small challenge in this.

There is chance where there could be a blank cell between two addresses. When I come across this scenario I get an error. Please assist me ?

E.g.
A1 - Fake Street ||| Fake St
A2 - Greet Road ||| Green Rd
A3 -
A4 -
A5 - Red trail ||| Red Trl