Macro Flag Records with Dash Alpha/Numeric

[JADownie]

I have a macro (below) used to clean up a file of addresses. One of my clean steps is to flag any addresses which contain number ranges (i.e. a dash "-"). It was working fine but now that I have a larger file with 10k+ addresses I think I need to adjust to make it less restrictive. Here are a few examples in the file that are probably legit because of apartment or lot numbers, but we’re excluding them. I know there’s only so much that can be done programmatically. But is there any way to allow them if there’s an alpha character before or after the dash? That would allow all of these back in:


112 E Amherst Street A - 17
14405 Columbiana-Canfield Road
1561 Edge Hill Rd. Apt. B-1
16300 pine ridge road Lot T-12
17014 Arrows-Peak Ln
2320 N. 196th Place Apt. Q-105
285 Quinnipiac Ave APT C-1
300 East 75th Street 7-H
3300 So. Sepulveda Blvd. Apt. K-17
235 W. 76th Street Apt # 14-B
2461 E.High St Apt.I-101

Below are examples of addresses I am concerned about and need to flag:

100-11 67th road 111
103-14 Metropolitan Ave. Apt. 1
110-11 72 ave apt 2a
146-26 243 street
147-26 70th Avenue
20-62 28th Street



------------------------------------

Sub H1_Copy_Dash()

Sheets("Dash Addresses").Visible = True

Dim strArray As Variant
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim NoRows As Long
Dim DestNoRows As Long
Dim i As Long
Dim J As Integer
Dim rngCells As Range
Dim rngFind As Range
Dim Found As Boolean

strArray = Array("-")

Set wsSource = ActiveSheet

NoRows = wsSource.Range("A100000").End(xlUp).Row
DestNoRows = 1
Set wsDest = ActiveWorkbook.Sheets("Dash Addresses")

For i = 1 To NoRows

Set rngCells = wsSource.Range("H" & i & ":H" & i)
Found = False
For J = 0 To UBound(strArray)
Found = Found Or Not (rngCells.Find(strArray(J)) Is Nothing)
Next J

If Found Then
rngCells.EntireRow.Copy wsDest.Range("A" & DestNoRows)

DestNoRows = DestNoRows + 1
End If
Next i

Sheets("Address Details").Select




End Sub


Thank You in advance for any suggestions here.

 

[JADownie]

Is there some way to use numeric wildcard values somehow to look for what I need?

strArray = Array("##-##")

 

[Yongle]

Have you considered RegEx?

1. Put this in UDF in a STANDARD module

Function aMatch(aRange As String) As String
    With CreateObject("vbscript.regexp")
        .Global = True: .MultiLine = True: .IgnoreCase = True
        .Pattern = "\d+\-\d+"
        aMatch = .Execute(aRange)(0)
    End With
End Function

2. Does data start in H1? Enter this formula in another column and copy down
=IFERROR(amatch(H1),"")

3. Does it correctly identify what you are concerned about?

 

[JADownie]

Hi -

I just tried this in my workbook now, and I don't think it was quite working. I tried this formula =IFERROR(amatch(H2),1) and the result was all blanks, but I was all "1" but I really only wanted the ones below in red to get flagged.


Col H Header (Row 1)
112 E Amherst Street A - 17
14405 North-Canfield Road
1561 Edge Hill Rd. Apt. B-1
16300 pine ridge road Lot T-12
17014 West-Peak Ln
2320 N. 196th Place Apt. Q-105
285 Quinnipiac Ave APT C-1
300 East 75th Street 7-H
3300 So. East Blvd. Apt. K-17
235 W. 76th Street Apt # 14-B
2461 E.High St Apt.I-101
100-11 67th road 111
103-14 Metropolitan Ave. Apt. 1
110-11 72 ave apt 2a
146-26 243 street
147-26 70th Avenue
20-62 28th Street

 

[Rick Rothstein]

Hi -

I just tried this in my workbook now, and I don't think it was quite working. I tried this formula =IFERROR(amatch(H2),1) and the result was all blanks, but I was all "1" but I really only wanted the ones below in red to get flagged.


Col H Header (Row 1)
112 E Amherst Street A - 17
14405 North-Canfield Road
1561 Edge Hill Rd. Apt. B-1
16300 pine ridge road Lot T-12
17014 West-Peak Ln
2320 N. 196th Place Apt. Q-105
285 Quinnipiac Ave APT C-1
300 East 75th Street 7-H
3300 So. East Blvd. Apt. K-17
235 W. 76th Street Apt # 14-B
2461 E.High St Apt.I-101
100-11 67th road 111
103-14 Metropolitan Ave. Apt. 1
110-11 72 ave apt 2a
146-26 243 street
147-26 70th Avenue
20-62 28th Street

I am a little unclear as to what you are looking for. It appears you want to identify addresses whose leading numbers are actually ranges of numbers. If so, you could test them with the Like operator, something like this maybe...

[table="width: 500"]
[tr]
	[td]LeadingNumber = Left(CellValue, InStr(CellValue, " ") - 1)
If LeadingNumber Like "*-*" And Not Replace(LeadingNumber, "-", "") Like "*[!0-9]*" Then
  MsgBox "The CellValue starts with a number range"
End If [/td]
[/tr]
[/table]

 

[JADownie]

Hi,

Unfortunately is may not always be the leading string. I am looking to capture cells that have a hyphen that also have a numerical value before and after the hyphen.

So I would want to capture records like:

100-11 67th road 111
103-14 Metropolitan Ave. Apt. 1
110-11 72 ave apt 2a
First Floor 146-26 243 street
All of 147-26 70th Avenue
20-62 28th Street

But exclude (where the hyphen is surrounded by letters)

2320 N. 196th Place Apt. Q-105
285 Quinnipiac Ave APT C-1
300 East 75th Street 7-H

 

[Rick Rothstein]

Hi,

Unfortunately is may not always be the leading string. I am looking to capture cells that have a hyphen that also have a numerical value before and after the hyphen.

So I would want to capture records like:

100-11 67th road 111
103-14 Metropolitan Ave. Apt. 1
110-11 72 ave apt 2a
First Floor 146-26 243 street
All of 147-26 70th Avenue
20-62 28th Street

But exclude (where the hyphen is surrounded by letters)

2320 N. 196th Place Apt. Q-105
285 Quinnipiac Ave APT C-1
300 East 75th Street 7-H

You could try this...

If Replace(CellValue, " ", "") Like "*#-#*" Then

But note that, as written, it will also identify ranges like 123-135B or A9-8B and so on. I can write code that will guarantee to find only pure number ranges, but the code will be slower. Will the above work for your data or would you like me to write the code to identify pure number ranges?

 

[JADownie]

Thanks Rick! I think this should be fine to capture records 123-135B or A9-8B

 

[JADownie]

Just trying to figure out now how to incorporate back into my original code now...

Sub H1_Copy_Dash()

Sheets("Dash Addresses").Visible = True

Dim strArray As Variant
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim NoRows As Long
Dim DestNoRows As Long
Dim i As Long
Dim J As Integer
Dim rngCells As Range
Dim rngFind As Range
Dim Found As Boolean

strArray = Array("-")

Set wsSource = ActiveSheet

NoRows = wsSource.Range("A100000").End(xlUp).Row
DestNoRows = 1
Set wsDest = ActiveWorkbook.Sheets("Dash Addresses")

For i = 1 To NoRows

Set rngCells = wsSource.Range("H" & i & ":H" & i)
Found = False
For J = 0 To UBound(strArray)
Found = Found Or Not (rngCells.Find(strArray(J)) Is Nothing)
Next J

If Found Then
rngCells.EntireRow.Copy wsDest.Range("A" & DestNoRows)

DestNoRows = DestNoRows + 1
End If
Next i

Sheets("Address Details").Select




End Sub

 

[JADownie]

Hi,

I am trying to update the red part of my code below with something like this "*#-#* but I have been unsuccessful so far. Any tips would be greatly appreciated!!



Sub H1_Copy_Dash()

Sheets("Dash Addresses").Visible = True

Dim strArray As Variant
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim NoRows As Long
Dim DestNoRows As Long
Dim i As Long
Dim J As Integer
Dim rngCells As Range
Dim rngFind As Range
Dim Found As Boolean

strArray = Array("-")

Set wsSource = ActiveSheet

NoRows = wsSource.Range("A100000").End(xlUp).Row
DestNoRows = 1
Set wsDest = ActiveWorkbook.Sheets("Dash Addresses")

For i = 1 To NoRows

Set rngCells = wsSource.Range("H" & i & ":H" & i)
Found = False
For J = 0 To UBound(strArray)
Found = Found Or Not (rngCells.Find(strArray(J)) Is Nothing)
Next J

If Found Then
rngCells.EntireRow.Copy wsDest.Range("A" & DestNoRows)

DestNoRows = DestNoRows + 1
End If
Next i

Sheets("Address Details").Select


End Sub