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