Removing unique variables such as emails and phone number with a macro

[isthisnametaken]

I am not a excel guru so any help provided is appreciated and easy to follow placement of code, etc would be extremely helpful. So I need to extract some data from a online system and convert it into an excel but a number of entries I do not need and want to get rid them with a macro. Here is an example of the data:

CXCUSTOMER: Customer Name : Forename,Surname
Customer Address : 6 Hollywood Close,,NSW,2076
Main Email : email@hotmail.com
Mobile Phone : 0987424311
Preferred Contact Method : Phone (this could also be email, mail, etc)
Alternate(1) Email : email1@hotmail.com
Alternate(2) Email : email2@hotmail.com
Home Phone : 78569999
Office Phone : , NOTES: A delivery van driver ran over my water meter and it has been bent and is squashed into the ground. I still have water and it does not appear to be leaking but it needs repairing. Also is there some sort of cage that can go over it to avoid this happening again?

So I am trying to find a way to list the field = Mobile Phone or Main Email, etc and remove that as well as the unique data post. Here is the code I am using currently that gets rid of the static field heading.

Thanks for any help you can give

Sub HansenClean()
'
' HansenClean Macro
' Hansen Clean Up
'

' Turn-off Screen updating:
Application.ScreenUpdating = False

Sheets("Suburbs").Select

' Turn filtering off
Worksheets("Suburbs").AutoFilterMode = False

' Find last row of data in Suburbs sheet
LastRow_District = Range("A65536").End(xlUp).Row + 1

Sheets("Sheet1").Select

' Turn filtering off
Worksheets("Sheet1").AutoFilterMode = False

' Find last row of data
LastRow_CleanUp = Range("A65536").End(xlUp).Row + 1


'
Cells.Replace What:="Preferred Contact Method : Email", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="Preferred Contact Method : Phone", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="Alternate(1) Email : ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="Alternate(2) Email : ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Range("H:H").WrapText = True

Columns("H:H").ColumnWidth = 40

Dim tbl As Range
Dim ws As Worksheet

Set tbl = Range("A1").CurrentRegion
Set ws = ActiveSheet

' I removed this because it was throwing an error
' ws.ListObjects.Add(SourceType:=xlSrcRange, Source:=tbl).Name = "HansenTables"

CurrentRow_District = 2
Do While CurrentRow_District < LastRow_District
District = ActiveWorkbook.Sheets("Suburbs").Range("A" & CurrentRow_District).Value ' Get the District Name
Asset = ActiveWorkbook.Sheets("Suburbs").Range("B" & CurrentRow_District).Value ' Get the Asset Name

CurrentRow_CleanUp = 2 'start on first row

Do While CurrentRow_CleanUp < LastRow_CleanUp
compare = ws.Range("F" & CurrentRow_CleanUp).Value ' Get text from the address
f = InStr(compare, District) ' Look for current District in address
If f > 0 Then ' If found add the District and associated Asset to the spreadsheet
ws.Range("K" & CurrentRow_CleanUp).Value = Asset
End If
CurrentRow_CleanUp = CurrentRow_CleanUp + 1
Loop
CurrentRow_District = CurrentRow_District + 1

Loop
End Sub

 

[johnnyL]

@isthisnametaken I am a little unsure of what you are asking for without seeing before and after examples from you.

It seems like you want to remove the first part of each field and leave the data that follows each field intact?

If that is the case then you could replace the following:

Cells.Replace What:="Preferred Contact Method : Email", Replacement:="", LookAt:=xlPart, SearchOrder _
       :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
   Cells.Replace What:="Preferred Contact Method : Phone", Replacement:="", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False
   Cells.Replace What:="Alternate(1) Email : ", Replacement:="", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False
   Cells.Replace What:="Alternate(2) Email : ", Replacement:="", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False

with:

    Cells.Replace What:="Customer Address : ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="Main Email : ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="Mobile Phone : ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="Preferred Contact Method : ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="Alternate(" & "?" & ") Email : ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="Home Phone : ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="Office Phone : , ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

If you want to completely remove all of the text from some or all, let us know which ones that need to be completely erased.

 

[isthisnametaken]

Before:

CXCUSTOMER: Customer Name : Forename,Surname
Customer Address : 6 Hollywood Close,,NSW,2076
Main Email : email@hotmail.com
Mobile Phone : 0987424311
Preferred Contact Method : Phone (this could also be email, mail, etc)
Alternate(1) Email : email1@hotmail.com
Alternate(2) Email : email2@hotmail.com
Home Phone : 78569999
Office Phone : , NOTES: A delivery van driver ran over my water meter and it has been bent and is squashed into the ground. I still have water and it does not appear to be leaking but it needs repairing. Also is there some sort of cage that can go over it to avoid this happening again?

After:

CXCUSTOMER: Customer Name : Forename,Surname
Customer Address : 6 Hollywood Close,,NSW,2076
Mobile Phone : 0987424311

Office Phone : , NOTES: A delivery van driver ran over my water meter and it has been bent and is squashed into the ground. I still have water and it does not appear to be leaking but it needs repairing. Also is there some sort of cage that can go over it to avoid this happening again?

So this might change depending on the requirements - example it might be decided that the Main Email Address is important so I can edit that in the code accordingly

Thanks

 

[Rick Rothstein]

Do you have more than one of these people data sets in the column that you need this done for?

If so, is there an empty row between each set?

For your output... do you want the "Office Phone" line and, if so, do you want it separated from the other three data elements as shown?

 

[isthisnametaken]

Do you have more than one of these people data sets in the column that you need this done for?

If so, is there an empty row between each set?

For your output... do you want the "Office Phone" line and, if so, do you want it separated from the other three data elements as shown?

Yes it might have up 200 cells that contain this data in the one column

No there is no space in between each line of data

It would be good to have that space as shown as it means it separates the persons details from the issue reported but it is not imperative. If the data taken out can also remove the line (so it is not leaving a blank line) that would be tops.

Cheers,

John

 

[isthisnametaken]

Cells.Replace What:="Home Phone : ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Mate, that seems to work a treat and pretty solves my issue. Thanks very much for your help. Massive kudos Cheers John

 

[johnnyL]

Glad we could help @isthisnametaken