Keeping leading zeros while copying to new worksheet

[llorcs]

Hi all!
Another day, another problem..

Here is what's going on:
I have an excel where there are two sheets. Sheet 1 contains Phone numbers in Column X in the following format: 050-7080-6030. I need to copy this to Sheet 2 while at the same time removing "-" (I achieved this by creating a table -see the code below-, for various reasons). I simply used recording for the copying part to paste it as a value -which works just fine- however, on Sheet 2 I lose all leading zeros. I have tried applying cell format as text for the whole sheet (both of them) and even vba code like NumberFormat = ... however nothing seems to work.
Here are the codes:

Sub copy2()
'
' copy2 Macro


'
Rows("3:10").Select
Range("D3").Activate
Selection.copy
Sheets("Sheet2").Select
Rows("3:10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


End Sub

Sub PhoneNumbers()


Dim wks As Worksheet
Dim fndList As Integer
Dim rplcList As Integer
Dim tbl As ListObject
Dim myArray As Variant


Set wks = Sheets("Sheet2")
Set tbl = Worksheets("ALL_DB").ListObjects("Phone")




Set TempArray = tbl.DataBodyRange
myArray = Application.Transpose(TempArray)




fndList = 1
rplcList = 2


With wks


For x = LBound(myArray, 1) To UBound(myArray, 2)



.Range("X3:X10").Replace What:=myArray(fndList, x), Replacement:=myArray(rplcList, x), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False



Next x
End With
End Sub


Anyone have any idea how to solve this?

Thank you in advance!

 

[yky]

set numberformat to "00000000000"

 

[Lidsavr]

I am an intermediate Excel programmer; however, I have run into a similar problem except I have a different number format. I used the following to show leading zeros. Even though Excel internally (behind the scenes) will strip the zeros, they still display on screen and print out (I have used your code and added what my line would be in red):

Sub copy2()
'
' copy2 Macro


'
Rows("3:10").Select
Range("D3").Activate
Selection.copy
Sheets("Sheet2").Select
Rows("3:10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
[COLOR="#FF0000"]Selection.NumberFormat="000-0000-0000"[/COLOR]


End Sub

Sub PhoneNumbers()


Dim wks As Worksheet
Dim fndList As Integer
Dim rplcList As Integer
Dim tbl As ListObject
Dim myArray As Variant


Set wks = Sheets("Sheet2")
Set tbl = Worksheets("ALL_DB").ListObjects("Phone")




Set TempArray = tbl.DataBodyRange
myArray = Application.Transpose(TempArray)




fndList = 1
rplcList = 2


With wks


For x = LBound(myArray, 1) To UBound(myArray, 2)



.Range("X3:X10").Replace What:=myArray(fndList, x), Replacement:=myArray(rplcList, x), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False

I hope this works for you. If not, perhaps someone else will give a better answer. Good luck.

Regards,

Charles (Lidsavr)

 

[llorcs]

Hi!
Thanks for your quick reply!

This seems to work, however, I now see that I forgot to add that not all phone numbers start with a 0 and as such, it creates invalid phone numbers.
Do you have another solution? Anything is appreciated!

 

[yky]

Would you give some representative numbers?

 

[llorcs]

Sure!

The data contains phone numbers from various countries, for example USA/Germany/Japan/South Korea etc. and as such can look like the following:

[TABLE="width: 409"]
<tbody>[TR]
[TD="class: xl63, width: 409"]301-123-4567
090-9876-54321
001-123-45678
20-123-4567
etc. etc.

By the way, I have found the following code while searcing the web:
<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; white-space: inherit;">For x = 1 to 100
If Sheets(origSheet).Cells(x, "A").Value <> "" Then
Sheets(origSheet).Cells(x, "A").Value = Chr(39) & Sheets(origSheet).Cells(x, "A").Value
End If</code>[/TD]
[/TR]
</tbody>[/TABLE]

If I paste this into the copy macro it works like a magic, however, I need to cover more than one column. In this code it only extends to one (A) while I would need it from A:D

 

[yky]

That code adds a leading apostrophe and, thus, converts numbers to text. Some people don't like to do it this way. That apostrophe is not that easy to remove.

If you like it, the no-brainer's way to do what you want is copy and paste the code four times and change the "A" to "B", "C", and "D". It's not elegant but it'll work.

I pasted the sample numbers to column A and used the formula "=SUBSTITUTE(A1,"-","")" to remove hyphen. All the leading zeros are preserved, even 00112345678.

 

[Bneder]

Hi, can someone pls help me ? When i copy values from 1 book to other, macro copy only 1 zero, but i need to copy 2.
Source data are formulas.

for example : source is 00 and after copy target is 0



Macro :

Sub Copy_test1()

    Dim Rng1 As String, Rng2 As String

    Rng1 = [D18].Value
    Rng2 = [N18].Value

    '      <<< Target   Source  >>>
    Range(Rng1).Value = Range(Rng2).Value

End Sub

File:
http://s000.tinyupload.com/index.php?file_id=02356331075070949623