Remove rows that contain apartment addresses

[kellman]

I would like to remove rows that contain any apartment style addressing, such as anything with a street number and unit number.

Example apartment address:
2 - 234 Smith Street

Example house address:
167 Jones Avenue



The data I'm importing into my excel sheet contains both apartment and house style addressing.

I need a way to display only house addresses, and not any apartments.

One thing in common about apartment addresses is they uniquely have a hyphen or dash - character.

Is there a way to tell excel to remove rows that contain addresses that have one or more hyphens?

I really appreciate your help!

Kelly

 

[Peter_SSs]

When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have repeated your code in the previous post and added the tags to the copy so that you can see the difference.

 

[kellman]

You forgot to specify which macro.
Post #9

Sub Maybe_Column_B()
Dim i As Long
    For i = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
        If InStr(Cells(i, 2), "-") <> 0 Then
            If Asc(Mid(Cells(i, 2), InStr(Cells(i, 2), "-") - 2, 1)) > 47 And Asc(Mid(Cells(i, 2).Value, InStr(Cells(i, 2), "-") + 2, 1)) < 58 Then Cells(i, 2).Offset(, -1).Resize(, 5).Delete Shift:=xlUp
        End If
    Next i
End Sub

Post #11

Sub Another_Possibility_Column_B()
Dim cons, i As Long, rws As Range
cons = Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row).Value
    For i = LBound(cons) To UBound(cons)
        If InStr(cons(i, 1), "-") <> 0 Then
            If Asc(Mid(cons(i, 1), InStr(cons(i, 1), "-") - 2, 1)) > 47 And Asc(Mid(cons(i, 1), InStr(cons(i, 1), "-") + 2, 1)) < 58 Then
                If Not rws Is Nothing Then
                    Set rws = Union(rws, Cells(i + 1, 1).EntireRow)
                        Else
                    Set rws = Cells(i + 1, 1).EntireRow
                End If
            End If
        End If
    Next i
rws.Select    '<---- Change to delete if happy.
End Sub

For Rick's code, if he permits me

Sub Maybe2()
  Dim R As Long
  For R = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
    If Cells(R, "B").Value Like "*# - #* *" Then Rows(R).Delete
  Next
End Sub

Lets go with Post # 9 Code

Thank you.

 

[Rick Rothstein]

Lets go with Post # 9 Code

Sub Maybe_Column_B()
Dim i As Long
For i = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
If InStr(Cells(i, 2), "-") <> 0 Then
If Asc(Mid(Cells(i, 2), InStr(Cells(i, 2), "-") - 2, 1)) > 47 And Asc(Mid(Cells(i, 2).Value, InStr(Cells(i, 2), "-") + 2, 1)) < 58 Then Cells(i, 2).Offset(, -1).Resize(, 5).Delete Shift:=xlUp
End If
Next i
End Sub

If you are going with Post #9, then why is my post marked as the Answer? You should change that and mark Post #9 as the Answer.

 

[Peter_SSs]

why is my post marked as the Answer?

Because I marked it as the solution.
Reason: In post #12 the OP had quoted your #10 post, commented "Brilliant, this also works." & marked that post (#12) as the solution - which clearly it isn't.
Hence my quote & comment at post #17, ay which point I marked your post. The OP is welcome to further change the marked solution should they so desire.

 

[kellman]

You forgot to specify which macro.
Post #9

Sub Maybe_Column_B()
Dim i As Long
    For i = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
        If InStr(Cells(i, 2), "-") <> 0 Then
            If Asc(Mid(Cells(i, 2), InStr(Cells(i, 2), "-") - 2, 1)) > 47 And Asc(Mid(Cells(i, 2).Value, InStr(Cells(i, 2), "-") + 2, 1)) < 58 Then Cells(i, 2).Offset(, -1).Resize(, 5).Delete Shift:=xlUp
        End If
    Next i
End Sub

Post #11

Sub Another_Possibility_Column_B()
Dim cons, i As Long, rws As Range
cons = Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row).Value
    For i = LBound(cons) To UBound(cons)
        If InStr(cons(i, 1), "-") <> 0 Then
            If Asc(Mid(cons(i, 1), InStr(cons(i, 1), "-") - 2, 1)) > 47 And Asc(Mid(cons(i, 1), InStr(cons(i, 1), "-") + 2, 1)) < 58 Then
                If Not rws Is Nothing Then
                    Set rws = Union(rws, Cells(i + 1, 1).EntireRow)
                        Else
                    Set rws = Cells(i + 1, 1).EntireRow
                End If
            End If
        End If
    Next i
rws.Select    '<---- Change to delete if happy.
End Sub

For Rick's code, if he permits me

Sub Maybe2()
  Dim R As Long
  For R = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
    If Cells(R, "B").Value Like "*# - #* *" Then Rows(R).Delete
  Next
End Sub

@jolivanes

Regarding my Question on Post #18

You asked me which of the 3 suggested codes posted would I like to use.
I'll go with the code from post # 9 (Below)
What is your suggestion to modify this code when the number of columns are fixed to 5, BUT the number of Rows will vary each day.
Some days i have 20 rows and other days I have 70 rows of data.

--------------------------------------------
VBA Code:
Sub Maybe_Column_B()
Dim i As Long
For i = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
If InStr(Cells(i, 2), "-") <> 0 Then
If Asc(Mid(Cells(i, 2), InStr(Cells(i, 2), "-") - 2, 1)) > 47 And Asc(Mid(Cells(i, 2).Value, InStr(Cells(i, 2), "-") + 2, 1)) < 58 Then Cells(i, 2).Offset(, -1).Resize(, 5).Delete Shift:=xlUp
End If
Next i
End Sub
---------------------------------------------

 

[jolivanes]

What happened to the 5 cells in Columns A to E when you tried it with a few rows making sure you had some data in column B that needed deleting and later tried it with lots of rows, again with data in column B that needed deleting?

Please use code tags and don't quote if not needed.

 

[kellman]

What happened to the 5 cells in Columns A to E when you tried it with a few rows making sure you had some data in column B that needed deleting and later tried it with lots of rows, again with data in column B that needed deleting?

Please use code tags and don't quote if not needed.

It works!
Sorry for my misunderstanding.
I thought you were asking me to pick one of the three suggested VB codes, and then you'd make the adjustment.

Everything works perfectly now.

Thank you!

 

[jolivanes]

Thanks for the update and good luck.