Text function to add zeros to values in a column

[Withnails]

Hi
I would like to ensure that all cells in column A have 7 digits, and where
they do not the first few are given as zeros. The following macro does this
by creating a new column, is it possible to simply grab the data below A1
(from A2 down) and achieve the same result...?

The code which works (but creates a new column that i would rather do
without) is as follows;

Selection.EntireColumn.Insert
ActiveCell.Select
ActiveCell.FormulaR1C1 = "=TEXT(RC[1],""00#####"")"
ActiveCell.Select
Selection.Copy
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, -1).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

End Sub

PS: As you can tell i'm pretty new to all this....

 

[Kassie]

Simply format Col A as Custom, 0000000. If you then enter a 1, it will
display as 0000001

--
HTH

Kassie

Replace xxx with hotmail

 

[p45cal]

Sub blah()
For Each cll In Range(Range("A2"), Range("A2").End(xlDown)).Cells
cll.NumberFormat = "@"
cll.Value = Format(cll.Value, "0000000")
' cll.NumberFormat = "General"
Next cll
End SubThe commented-out line is optional and returns th
cell format to General, while retaining the leading zeroes, which i
closest to your macro's resiult, however, editing any of those cell
will cause it to revert to displaying without leading zeroes, so
guessed you wouldn't want that so commented it out.
It also assumes there are no gaps in the data below A2

 

[Rick Rothstein]

First, I'm assuming you determined that a Custom Format of 0000000 does not
do what you want. If that is the case, then you can make what you want
happen automatically by doing the following. Right click the tab at the
bottom of the worksheet, select View Code from the popup menu that appears
and then Copy/Paste the following into the code window that opened up...

Private Sub Worksheet_Change(ByVal Target As Range)
' In case the user deletes a value
If Len(Target.Value) = 0 Then Exit Sub
' Process only cell in Column 1, from Row 2 downward
If Target.Column = 1 And Target.Row > 1 Then
' Turn on error trapping in case something goes wrong
On Error GoTo FixItBackUp
' Turn off events in case we have to change the Target value
Application.EnableEvents = False
' Test for digits only and that there are 7 or less of them
If Not Target.Value Like "*[!0-9]*" And Len(Target.Value) <= 7 Then
' Format the number to 7 digits with leading zeroes
Target.Value = Format(Target.Value, "'0000000")
Else
'
' The user did not enter digits only... put any code
' you need to for that situation here. For example...
'
' Alert the user his/her entry is invalid
MsgBox Target.Value & " is not a valid entry!"
' Remove the invalid value
Target.Value = ""
' Make the target cell active again in case user clicked elsewhere
Target.Select
End If
End If
FixItBackUp:
' Turn event trapping back on
Application.EnableEvents = True
End Sub

Now, when you go back to the worksheet and type a 7-digit or less number
into a cell in Column A, Row 2 on downward, that number will automatically
be physically changed to one with leading zeroes. Any other entry will (as I
have set it up, but which is changeable by you) trigger a warning message to
appear and, when the user dismisses the MessageBox, the entry will be
removed).

--
Rick (MVP - Excel)

Hi
I would like to ensure that all cells in column A have 7 digits, and where
they do not the first few are given as zeros. The following macro does
this
by creating a new column, is it possible to simply grab the data below A1
(from A2 down) and achieve the same result...?

The code which works (but creates a new column that i would rather do
without) is as follows;

Selection.EntireColumn.Insert
ActiveCell.Select
ActiveCell.FormulaR1C1 = "=TEXT(RC[1],""00#####"")"
ActiveCell.Select
Selection.Copy
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, -1).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

End Sub

PS: As you can tell i'm pretty new to all this....