Leading Zeros (THIS TOPIC IS NOW CLOSED OUT)

Jak

Well-known Member
Joined
Apr 5, 2002
Messages
817
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
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Assuming that column C is created from the TextToColumns code, add another loop below your existing loop, referring to column 3:

Code:
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

Well-known Member
Joined
Apr 5, 2002
Messages
817
Thanks Andrew Poulsom

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

Forum statistics

Threads
1,143,614
Messages
5,719,720
Members
422,242
Latest member
hishamkhatri

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top