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

isthisnametaken

New Member
Joined
Aug 9, 2021
Messages
4
Office Version
  1. 365
Platform
  1. Windows
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
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
1,860
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
@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:

VBA Code:
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:

VBA Code:
    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.
 
Solution

isthisnametaken

New Member
Joined
Aug 9, 2021
Messages
4
Office Version
  1. 365
Platform
  1. Windows
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

MrExcel MVP
Joined
Apr 18, 2011
Messages
37,561
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
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

New Member
Joined
Aug 9, 2021
Messages
4
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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

New Member
Joined
Aug 9, 2021
Messages
4
Office Version
  1. 365
Platform
  1. Windows
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
 

Forum statistics

Threads
1,148,396
Messages
5,746,452
Members
424,020
Latest member
LongDoo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top