Leading Zeros (THIS TOPIC IS NOW CLOSED OUT)

[Jak]

The following macro which was created by Damon Ostrander adds zeros to the begining of a line in order that no data is less than six characters.

What I would like the macro to do is perform this task on columns 1 and 3. At present it does column 1 only. Any help would be welcomed.

Sub LeadingZeros()

Application.ScreenUpdating = False

Columns("A:A").TextToColumns _
Destination:=Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=False, _
Comma:=True, _
SPACE:=False, _
Other:=False, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), _
Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), _
Array(8, 1), Array(9, 1))
Rows("1:1").Insert Shift:=xlDown
[A1] = "F1"
[B1] = "F2"
[C1] = "F3"
[D1] = "F4"
[E1] = "F5"
[F1] = "F6"
[G1] = "F7"
[H1] = "F8"
[I1] = "F9"

i = 0

Do While i< 500
i = i + 1

Cells(i, 1).Select

CellValue = ActiveCell.Value
If IsNumeric(CellValue) = True And Not CellValue = "" Then
CellValue = CStr(CellValue)
TheLenght = Len(CellValue)
Do While TheLenght< 6
CellValue = "0" + CellValue
TheLenght = Len(CellValue)
Loop
ActiveCell.Value = "'" + CellValue
End If

Loop

Columns("A:I").EntireColumn.AutoFit
Cells.Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
Range("A1").Select
Application.ScreenUpdating = True
End Sub
This message was edited by Jak on 2002-10-31 12:00

 

[Andrew Poulsom]

Assuming that column C is created from the TextToColumns code, add another loop below your existing loop, referring to column 3:

i = 0 
Do While i < 500 
   i = i + 1 
   Cells(i, 3).Select 
   CellValue = ActiveCell.Value 
   If IsNumeric(CellValue) = True And Not CellValue = "" Then 
      CellValue = CStr(CellValue) 
      TheLenght = Len(CellValue) 
      Do While TheLenght < 6 
         CellValue = "0" + CellValue 
         TheLenght = Len(CellValue) 
      Loop 
      ActiveCell.Value = "'" + CellValue 
   End If 
Loop

Not the most elegant solution but it should work.

 

[Jak]

Thanks Andrew Poulsom

Added a secondary loop and it did the trick. Many thanks for the idea and quick reply.