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

 

[kellman]

Try on a copy of your original first.

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

Oh wow, that works nicely.

Thank you for taking the time to help me!

Happy New Year

 

[kellman]

Here is another macro that you can try...

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

Brilliant, this also works.

I don't have any VB experience so for me it's hard to tell which of the two solutions are better "maybe" or "maybe2".

Thank you so very much!!

 

[jolivanes]

If you have a large range of data and you want to stay away from looping.

Sub Another_Possibility()
Dim cons, i As Long, rws As Range
cons = Range("A2:A" & Cells(Rows.Count, 1).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

To make it more up to date, replace part of above with Rick's (better) suggestion.

 

[kellman]

Thank you, I will definitely give your suggestion a try.

The raw CSV data that I copy & paste into Excel each day has 112 Columns and anywhere from 20 to 70 Rows

I just learned how to use the Macro Recorder to trim down the columns down to about 5 columns (the ones with the data I need). What a fantastic tool and time saver!

The last part I need to figure out is text formatting, or rather how to automate the text formatting.

The Macro I recorded on the spreadsheet I used only had about 20 rows. But then what I noticed is, when I ran the same Macro on a sheet with 70 Rows, it stopped formatting my text at row 20.

I'm thinking I'll need something more specific for sheets with varying Rows of data

Perhaps VB Script is the solution again.

I wonder if I should post an example of my text formatting here, or if I should create a new topic/thread?

Regards

Nothing to eloborate, Column Heading in Bold and then each Row I'm using the format "bottom border" button.

GLB for Dec 8.xlsx
	A
1	Address
2	215 GREENWAY CRES W
3	79 BERRY HILL RD
4	72 GREENSBORO BAY
5	38 OAKLEAF DR
6	920 CHANCELLOR DR
7	131 WINTERHAVEN DR - STVTL
8	15 OAKRIDGE BAY - STVTL
9	375 CASTLEBURY MEADOWS DR - OKLD
10	427 - 20 INNSBRUCK WAY - WPG
11	38 FETTERLY WAY
12	241 WALES AV - STVTL
13	51 CURRY DR - HDLY
14	115 BRIARLYNN RD - FTGRY
15	190 LEAHCREST CRES
16	119 RYERSON AV
17	159 CREEKSIDE RD - FTGRY
18	78 RUTGERS BAY - FTGRY
19	77 GALBRAITH CRES - ASNBOIA
20	14 GEORGE BARONE BAY - NKLD
21	51 CAUSEWAY BAY - STBON
22	3403 GRANT AV - CHLSWD
23	70 MARSEILLES CL - WPG
24	65 COLCHESTER BAY - TUX
25	115 BAYLOR AV - FTGRY
26	147 GEMINI AV - NKLD
27	737 SHEPPARD ST - WPG
28	141 BAYLOR AV - FTGRY
29	23 TIMMINS PL - WPG
30	15 BAIRD PL - NKLD
31	158 BRIXTON BAY - STVTL
32	79 TARASKA BAY - WPG
33	7051 PR 247 E
34	23 SCHAUBROECK RD
35	20 VERONA DR
36	3373 PEMBINA HWY
37	46 SERENITY COVE
38	172 BERRY HILL RD - FTGRY
39	344 NOVAVISTA DR - STVTL
40	713 DE LA SEIGNEURIE BLVD - STBON
41	7 EDITH BAY - NKLD
42	293 APPLEFORD GATE - FTGRY
43	60 VAN HORNE RD
Sheet1

 

[jolivanes]

Since it is a different problem, I would think that a new thread would be better.
If you need to refer to this thread, just put a hyperlink with the address of this thread in your post.

 

[Peter_SSs]

For the original question, it is looking like a macro may be best for you but if you wanted to pursue a formula approach, you could try this version.
Formula still only required in the very top cell of the results area.

23 01 01.xlsm
	A	B	C
1	Address
2	402 - 775 STERLING LYON PKWY - TUX		140 KAIRISTINE LANE - WPG
3	140 KAIRISTINE LANE - WPG		133 LINDSAY ST
4	133 LINDSAY ST		26 KEYSTONE CRES - OKLD
5	26 KEYSTONE CRES - OKLD		69 MICHAUD CRES - STVTL
6	69 MICHAUD CRES - STVTL		2096 DE VRIES AV
7	2096 DE VRIES AV		128 CALLUM CRES - NKLD
8	103 - 1032 WILKES AV - TUX		15 TUNIS BAY - FTGRY
9	128 CALLUM CRES - NKLD		9 RAPHAEL ST - FTGRY
10	15 TUNIS BAY - FTGRY		408 YALE AV E - TRANS
11	9 RAPHAEL ST - FTGRY		322 CHURCH AV - FLR 2 - WPG
12	202 - 707 STERLING LYON PKWY - TUX		325 HARVARD AV W - TRANS
13	412 - 2475 WAVERLEY ST - FTGRY		15 HADLEY PL - FTGRY
14	408 YALE AV E - TRANS		93 EGESZ ST - WPG
15	228 - 55 DAYLAN MARSHALL GATE - WPG		41 ROSLYN CRES - WPG
16	404 - 707 STERLING LYON PKWY - TUX		428 REGENT AV E - TRANS
17	322 CHURCH AV - FLR 2 - WPG		10 ALDERWOOD RD - STBON
18	325 HARVARD AV W - TRANS		27 STREWCHUK BAY - OKLD
19	15 HADLEY PL - FTGRY		279 HAZELWOOD AV - STVTL
20	93 EGESZ ST - WPG
21	37 - 59 UNIVERSITY CRES - FTGRY
22	41 ROSLYN CRES - WPG
23	428 REGENT AV E - TRANS
24	12 - 55 UNIVERSITY CRES - FTGRY
25	10 ALDERWOOD RD - STBON
26	1517 - 1750 PEMBINA HWY - FTGRY
27	27 STREWCHUK BAY - OKLD
28	279 HAZELWOOD AV - STVTL
Addresses (2)

Cell Formulas
Range	Formula
C2:C19	C2	=FILTER(A2:A28,ISERROR(-SUBSTITUTE(MID(A2:A28,FIND(" - ",A2:A28)-1,5)," - ","")))
Dynamic array formulas.

 

[Peter_SSs]

Brilliant, this also works.

The marked solution has been changed accordingly.
In your future questions, please mark the post as the solution that actually answered your question, instead of your feedback message as it will help future readers. No further action is required for this thread.

 

[kellman]

One last question still relating to my original question.
When I use the VB Code you provided on a sheet with more than 1 Column, it doesn't work.

I will provide a more accurate example of what my final project sheet will look like.

I'm assuming the Range will need to be changed in order for the VB script to work correctly.

There will be 5 fixed Columns but the number of Rows will need to be variable somehow.

I would appreciate if you could take one last look at my scenario.

FTTH GLB DEC 8TH.csv
	A	B	C	D	E
1	Start Time	Address	City	Job id	Source Order ID
2
3
4
5
6
7
8
9
10
11
12
FTTH GLB DEC 8TH

 

[jolivanes]

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

 

[kellman]

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

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