This looks like another homework assignment. I only solved some of the
problems this code won't work in every situation, but probably will look like
it gives the correct answers. You will have to find the cases where itwon't
work.
Sub ExpandRange()
Dim StartStr As String
Dim EndStr As String
Dim StartMSB As String
Dim EndMSB As String
Dim StartLSB As Double
Dim EndLSB As Double
'make header row
Range("H2") = "ITEM NAME"
Range("I2") = "Item NUMBER"
Range("J2") = "DATE"
'format column I as text
Columns("I").NumberFormat = "@"
NewRow = 3
RowCount = 3
Do While Range("A" & RowCount) <> ""
Item = Range("A" & RowCount)
StartStr = Range("B" & RowCount)
EndStr = Range("C" & RowCount)
If StartStr = "" Or _
EndStr = "" Then
MsgBox ("Please enter values in Row : " & RowCount & _
vbCrLf & "Exiting Macro")
Exit Sub
End If
'split Start Number into
' MSB - Most significant part
' LSB - Least significant part
If Len(StartStr) > 10 Then
StartMSB = Left(StartStr, Len(StartStr) - 10)
StartLSB = Val(Right(StartStr, 10))
EndMSB = Left(EndStr, Len(EndStr) - 10)
EndLSB = Val(Right(EndStr, 10))
Else
StartMSB = ""
StartLSB = Val(StartStr)
EndMSB = ""
EndLSB = Val(EndStr)
End If
If StartLSB > EndLSB Then
MsgBox ("Please provide correct ranges in row : " & RowCount & _
vbCrLf & "Exiting Macro")
Exit Sub
End If
ItemDate = Range("E" & RowCount)
'get number of leading zeroes in LSB
'if numbers
If StartMSB <> "" Then
If Val(StartMSB) = 0 Then
ZeroCount = 0
For CharPos = 1 To Len(StartMSB)
If Mid(StartMSB, CharPos, 1) = "0" Then
ZeroCount = ZeroCount + 1
Else
Exit For
End If
Next CharPos
End If
End If
If ZeroCount = 0 Then
Leader = ""
Else
Leader = String(ZeroCount, "0")
End If
I = StartLSB
Do While I <= EndLSB
Range("H" & NewRow) = Item
Range("I" & NewRow) = StartMSB & Leader & I
Range("J" & NewRow) = ItemDate
NewRow = NewRow + 1
I = I + 1
Loop
RowCount = RowCount + 1
Loop
End Sub
- Show quoted text -
Thanks both of you for your time..
Don good to hear from you.
Joel your new script worked but for some ranges it is showing
additonal zero and in some cases zero is skipped.
Only the first 19 length number is generated kwel.
Well guys I have this one script below which I got from google back
sometime.
It uses a form to make the lists but generates the list column to
column, like if the list is generated in columnA, the second list will
be in columnB or the next empty column.
-----------------script start---------------------
Private Sub CommandButton1_Click()
Dim X As Long
Dim LastColumn As Long
Dim Number1 As Variant
Dim Number2 As Variant
Dim TBox1 As String
Dim TBox2 As String
TBox1 = Trim(TextBox1.Text)
TBox2 = Trim(TextBox2.Text)
If TBox1 = "" Or TBox2 = "" Then
MsgBox "You must fill in both text boxes!"
ElseIf TBox1 Like String(Len(TBox1), "#") And Len(TBox2) < 29 Then
Number1 = CDec(TBox1)
If TBox2 Like String(Len(TBox2), "#") And Len(TBox2) < 29 Then
Number2 = CDec(TBox2)
If Number2 < Number1 Then
MsgBox "Ending number must contain an equal or larger number
than Starting!"
Else
LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
If LastColumn = 1 And Range("A1").Value = "" Then LastColumn =
0
For X = 0 To Number2 - Number1
Cells(X + 1, LastColumn + 1).Value = _
"'" & Format$(Number1 + X, String(Len(Trim(TBox1)),
"0"))
Next
End If
Else
MsgBox "Bad entry in Ending text box"
End If
Else
MsgBox "Bad entry in Starting text box"
End If
End Sub
-----------------script end---------------------
The form at the moment has two text boxes
START
END
with one button "GENERATE LIST". that all.
I was wondering if you can add another drop downlist in the form with
item name list and a text box with date in it.
User input will require
Start
End
Item name (to be selected from drop down list which can be updated
from time to time with new item names)
Location ( to be selected from drop down list which can be updated
from time to time with new item names )
Date (dd/mm/yyyy)
Extra infomation1 text box (additional column which I can use later on
so that i dont bug ya to add another test box in the form for me
)
Extra infomation2 text box (additional column which I can use later
on so that i dont bug ya to add another test box in the form for
me
)
Extra infomation3 text box (additional column which I can use later
on so that i dont bug ya to add another test box in the form for
me
)
The original file that i'm using is at
http://www.filefactory.com/file/a0e6292/n/Generate_List_xls
I have modified the form which is in file "Generate List required" at
http://www.filefactory.com/file/a0e635h/n/Generate_List_required_xls
Sorry Joel, I dont have your email. Hope you reply soon.
Thank once again for your time & input.
