InTheDogHouse
New Member
- Joined
- May 29, 2013
- Messages
- 2
Hello
This is my first time posting. I have a limited amount of VBA knowledge. My limited knowledge is based on solving my problems by looking at the answers already on this site and trying to adapt it to my needs. Here goes:
I import a list of address and telephone numbers (100+) into excel. example - Cell A1 contains "10 downing street, whitehall, london, SW1A 2AA 01234 567890", sometimes there is another space after the number, sometimes there is no telephone number. I want to remove the telephone number at the end if it is there. Have searched the forums have have come up with the follow solution:
1. import list to column A
2. copy and paste Trim to column B
3. copy values in column B and paste to column A
4. delete column B
5. remove the end numbers
6. copy and paste Trim to column B
7. copy values in column B and paste to column A
8. delete column B
9. remove the end numbers
It looks like this in code:
Sub testa()
'select (=TRIM(A1)) formula and paste to sheet
Sheets("Formulas").Select
Columns("B:B").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet4").Select
Columns("B:B").Select
ActiveSheet.Paste
End Sub
Sub testb()
'remove last set of numbers
Dim cellText As String
Dim i As Integer
For i = 1 To 10000
Range("A" & i).Select
'Get the text from the cell
cellText = Selection.Text
'As long as there is a number on the right, chop it off
While IsNumeric(Right(cellText, 1))
cellText = Left(cellText, Len(cellText) - 1)
Wend
'Write the new text string back into the cell
Selection.Value = cellText
Next
End Sub
Sub testc()
'copy values of column B to Column A and delete column B
Columns("B:B").Select
Selection.Copy
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("B:B").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A1").Select
End Sub
Sub testd()
'select (=TRIM(A1)) formula and paste to sheet
Sheets("Formulas").Select
Columns("B:B").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet4").Select
Columns("B:B").Select
ActiveSheet.Paste
End Sub
Sub teste()
'remove last set of numbers
Dim cellText As String
Dim i As Integer
For i = 1 To 10000
Range("A" & i).Select
'Get the text from the cell
cellText = Selection.Text
'As long as there is a number on the right, chop it off
While IsNumeric(Right(cellText, 1))
cellText = Left(cellText, Len(cellText) - 1)
Wend
'Write the new text string back into the cell
Selection.Value = cellText
Next
End Sub
Sub testf()
'copy values of column B to Column A and delete column B
Columns("B:B").Select
Selection.Copy
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("B:B").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A1").Select
End Sub
I know this is a long winded way around (still chuffed I worked it out by myself though!). If I merge all the macros into one marco it continually loops and deletes everything in the cells and I have to press escape to stop it.
My questions are:
1. Why, when I merge all the macros doesnt it work the same as individual macros? (I would like to know for future reference).
2. Its there a better way to remove the telephone numbers?
Many thanks
InTheDogHouse
This is my first time posting. I have a limited amount of VBA knowledge. My limited knowledge is based on solving my problems by looking at the answers already on this site and trying to adapt it to my needs. Here goes:
I import a list of address and telephone numbers (100+) into excel. example - Cell A1 contains "10 downing street, whitehall, london, SW1A 2AA 01234 567890", sometimes there is another space after the number, sometimes there is no telephone number. I want to remove the telephone number at the end if it is there. Have searched the forums have have come up with the follow solution:
1. import list to column A
2. copy and paste Trim to column B
3. copy values in column B and paste to column A
4. delete column B
5. remove the end numbers
6. copy and paste Trim to column B
7. copy values in column B and paste to column A
8. delete column B
9. remove the end numbers
It looks like this in code:
Sub testa()
'select (=TRIM(A1)) formula and paste to sheet
Sheets("Formulas").Select
Columns("B:B").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet4").Select
Columns("B:B").Select
ActiveSheet.Paste
End Sub
Sub testb()
'remove last set of numbers
Dim cellText As String
Dim i As Integer
For i = 1 To 10000
Range("A" & i).Select
'Get the text from the cell
cellText = Selection.Text
'As long as there is a number on the right, chop it off
While IsNumeric(Right(cellText, 1))
cellText = Left(cellText, Len(cellText) - 1)
Wend
'Write the new text string back into the cell
Selection.Value = cellText
Next
End Sub
Sub testc()
'copy values of column B to Column A and delete column B
Columns("B:B").Select
Selection.Copy
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("B:B").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A1").Select
End Sub
Sub testd()
'select (=TRIM(A1)) formula and paste to sheet
Sheets("Formulas").Select
Columns("B:B").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet4").Select
Columns("B:B").Select
ActiveSheet.Paste
End Sub
Sub teste()
'remove last set of numbers
Dim cellText As String
Dim i As Integer
For i = 1 To 10000
Range("A" & i).Select
'Get the text from the cell
cellText = Selection.Text
'As long as there is a number on the right, chop it off
While IsNumeric(Right(cellText, 1))
cellText = Left(cellText, Len(cellText) - 1)
Wend
'Write the new text string back into the cell
Selection.Value = cellText
Next
End Sub
Sub testf()
'copy values of column B to Column A and delete column B
Columns("B:B").Select
Selection.Copy
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("B:B").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A1").Select
End Sub
I know this is a long winded way around (still chuffed I worked it out by myself though!). If I merge all the macros into one marco it continually loops and deletes everything in the cells and I have to press escape to stop it.
My questions are:
1. Why, when I merge all the macros doesnt it work the same as individual macros? (I would like to know for future reference).
2. Its there a better way to remove the telephone numbers?
Many thanks
InTheDogHouse