View Single Post
  #1   Report Post  
TimLeonard TimLeonard is offline
Member
 
Posts: 46
Default leading zeros using ActiveCell.Offset().value to insert row and value

I am using the following code to insert missing rows of alphanumeric values. While it does work it is removing the leading zeros as shown below...
I have tried playing the the cell formats, with no sucess, Any ideas how to correct this behavior???

Also how can I add the ability to verify the number sequence will start at LxxD159 & LxxM159 respectively, where xx ranges from 1 to 10 (this could get the value from another worksheet.)



L01D001
L01D002
L01D003
L01D159
L01M001
L01M002
L01M3 <----
L01M4 <----
L01M005


Sub test()
Dim val1 As String, txt1 As String, xNum As Long
Dim WorkRows As Long, _
Ndx As Long, _
Diff As Long, _
InsertCounter As Integer, _
WorkColumn As String

WorkColumn = "A" ' <<<<<<< CHANGE TO YOUR COLUMN

WorkRows = Cells(Rows.Count, WorkColumn).End(xlUp).Row

'Starting Len Value
xNum = 5

'Start at the bottom of the list and work up to the top
'that way ndx will always poin to the row just above the ones
'that were inserted

For Ndx = WorkRows To 2 Step -1
Cells(Ndx, WorkColumn).Activate

val1 = Selection.Cells(1).Value
txt1 = Left(val1, xNum - 1)

'establish the rows to insert
val1 = Right(Selection.Cells(1).Value, Len(Selection.Cells(1).Value) - xNum + 1)

Diff = Right(Cells(Ndx, WorkColumn).Value, Len(Cells(Ndx, WorkColumn).Value) - xNum + 1) - Right(Cells(Ndx - 1, WorkColumn).Value, Len(Cells(Ndx - 1, WorkColumn).Value) - xNum + 1)

If Diff 1 Then
For InsertCounter = 1 To Diff - 1
Range(WorkColumn & Ndx).EntireRow.Insert

ActiveCell.Value = txt1 & Right(ActiveCell.Offset(1, 0).Value, Len(ActiveCell.Offset(1, 0).Value) - xNum + 1) - 1

Next InsertCounter
End If
Next Ndx
End Sub