Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
GENERATE RANGES FROM GIVEN NUMBERS(START/END) AND COMPILE INTO ASINGLE LIST.
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. |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
GENERATE RANGES FROM GIVEN NUMBERS(START/END) AND COMPILE INTO
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. |
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
GENERATE RANGES FROM GIVEN NUMBERS(START/END) AND COMPILE INTO
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. |
#5
Posted to microsoft.public.excel.misc
|
|||
|
|||
GENERATE RANGES FROM GIVEN NUMBERS(START/END) AND COMPILE INTO
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. |
#6
Posted to microsoft.public.excel.misc
|
|||
|
|||
GENERATE RANGES FROM GIVEN NUMBERS(START/END) AND COMPILE INTO
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 |
#7
Posted to microsoft.public.excel.misc
|
|||
|
|||
GENERATE RANGES FROM GIVEN NUMBERS(START/END) AND COMPILE INTO
On Oct 6, 4:45*pm, Angela wrote:
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 ... read more »- Hide quoted text - - Show quoted text - Joel, I have checked again. For a value like 2941007010004001623 it is giving 2941007014001623 2941007010531111266 it is giving 294100701531111266 I think the 10th figure zero.. its eating it up... Hope you can fix this as well. Thankyou. |
#8
Posted to microsoft.public.excel.misc
|
|||
|
|||
GENERATE RANGES FROM GIVEN NUMBERS(START/END) AND COMPILE INTO
Hey Joel, I have managed it to work by replacing all the 10 with 7 in
the code. It is giving the desired results. Well, u can check if u want to..... will keep ya posted if I get some problem. Thanks alot. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Get a VB "Compile error in hidden module: DistMon" at start | Excel Discussion (Misc queries) | |||
compile error in hidden module: AutoExecNew by start of Excel? | Excel Discussion (Misc queries) | |||
compile list | Excel Discussion (Misc queries) | |||
How to generate a list of randomly selected numbers within a range | Excel Worksheet Functions | |||
Compile numbers from multiple worksheets | Excel Worksheet Functions |