On Oct 6, 4:28*pm, Joel wrote:
I made a couple of very minor changes to fix the problems.

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
Dim StartLSBStr As String

'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))
* * * StartLSBStr = Right(StartStr, 10)

* * * EndMSB = Left(EndStr, Len(EndStr) - 10)
* * * EndLSB = Val(Right(EndStr, 10))
* *Else
* * * StartMSB = ""
* * * StartLSB = Val(StartStr)
* * * StartLSBStr = 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(StartLSBStr)
* * * * * * If Mid(StartLSBStr, 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



"Angela" wrote:
On Oct 5, 6:32 am, Joel wrote:
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 it won'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

"Don Guillett" wrote:
Since Excel only uses the 1st 15, can you limit your number to 15 characters
and then custom format to 00000000000000 15 0's

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Angela" wrote in message
....
Hi,

I want to do a simle routine in excel which will save me alot of time..

I have mentioned the details in the excel file which is at following
location.

http://www.filefactory.com/file/a0ehgfh/n/MakeList_xls

Simply put, I would like to make a list between 2 numbers.
When the first range is done, I want the second range to start from
just below the last cell of first range i.e. no gaps between two
ranges making it a single list. Header of the list is "SAMPLE RANGE"
which I will change later on. Two columns i.e. "ITEM NAME" and "DATE"
also required as mentioned in the sheet.

A small code also required that would count the "QUANITY" in backgound
between "START" and "END" values. Formula would take time as the list
grows.

Some are large numbers, others start with zeros so need to cater that
also.

If there is no start and end, or end value is smaller than start, the
code should give error accordingly.
case1 (when no values) "Please enter values."
case2 (when end is smaller than start) "Ending value is smaller than
Starting value. Please provide correct ranges."

Thx.- Hide quoted text -

- 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/a0e6...erate_List_xls

I have modified the form which is in file "Generate List required" at
http://www.filefactory.com/file/a0e6...t_required_xls

Sorry Joel, I dont have your email. Hope you reply soon.

Thank once again for your time & input.- Hide quoted text -

- Show quoted text -

Yahoo!! it worked : )

Thx Joel.
Hey if you get time do check the new sheets that I send to you.
If you can help me with those as well.
One is original & the other one is required.

Thanks alot anywaysssssss : D yipeee