CODEWITHSUNDEEP
vbacopyformatcellleading-zero
llorcs
llorcs

Reputation: 79

VBA - Losing all leading zeroes when copying

I have a slight problem with my new VBA code..

Here is what's going on: I have an excel where there are two sheets(+1 that contains a database). Sheet 1 contains Phone numbers in Column G in the following format: 050-7080-6030 / 301-123-456 / 06-1234-4567 etc. 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 after running the second macro. 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. Any idea how to resolve this? Thanks in advance! Here are the codes:

Sub copy()

'copy

Rows("4:6").Select
Selection.copy
Sheets("Sheet2").Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End Sub

Sub Multi_FindReplace()

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("DBs").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("G3:I100").Replace What:=myArray(fndList, x), Replacement:=myArray(rplcList, x), _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, _
        SearchFormat:=False, ReplaceFormat:=False


Next x

End With

End Sub

Upvotes: 0

Views: 1540

Answers (1)

viper941
viper941

Reputation: 156

The issue is caused in the way that Excel handles replacement. It is reformatting your text string into a number which of course drops the leading zeros.

Using the replace command actually leaves the original formatting.

On Error GoTo Done:
Do
Range("G3:I100").Select
    Selection.Find(What:="-", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
        ActiveCell = Replace(ActiveCell.Value, "-", "")
Loop
Done:

Notice that this is technically an infinite loop as there is no condition to exit the loop. The exit here is actually the error generated by not finding the "-" within the specified range.

I find this an easy method if you have a finite area to search. If it is a variable area then replace the selection line with an array defined before the loop.

Upvotes: 1

Related Questions