PDA

View Full Version : Solved: Help please...input box issue...



Renato
01-22-2009, 08:35 AM
Greetings

I am starting to create macros in excel and i need some help from anyone.

I have a sheet with one column. This column has a list of material numbers.

What i intend to do is to create a macro that when started it shows an input box where by entering the number of materials i desire and by clicking "ok" in another sheet it creates a list of materials from the original list randomly.

For example if i input 100 on the input box it gets ramdomly 100 material numbers from that list and places then on the other sheet.


Sorry about my english and i hope i could transmit my intentions.

I really need this..

Please help ok?

Thanks

lucas
01-22-2009, 09:08 AM
This sounds like school work. Why else would you want random selections?

Renato
01-22-2009, 09:13 AM
This is for stock control...i'm doing a method to make randomly selections in stock in order to have the trust interval i desire.

It is for stock accuracy issues.

lucas
01-22-2009, 09:19 AM
Do you want the whole row or just the data in the column?

Renato
01-22-2009, 09:31 AM
I want the macro to randomly select the a group of values from the original column and place them in the other column on other sheet.

The size of the group of values is given by the input box

crazymatt1
01-22-2009, 10:07 AM
I made two options -- one that chooses unique values and one that allows repeats. These both assume that your original data is in column A of a worksheet named "Data".

Unique:
Private Sub cmdUnique_Click()
Dim AlreadyGot() As Integer
Dim NumToGet As Integer
Dim LastRow As Integer
Dim RowNum As Integer

On Error GoTo Deal

NumToGet% = InputBox("Return how many entries", "Input", "0")
ReDim AlreadyGot(1 To NumToGet%)

LastRow% = 0
Do
LastRow% = LastRow% + 1
Loop Until Cells(LastRow%, 1).Value = ""
LastRow% = LastRow% - 1

If NumToGet% > LastRow% Then
EndItAll = MsgBox("There are only " & LastRow% & " entries available.", vbCritical + vbOKOnly, "Error")
Exit Sub
End If

ActiveWorkbook.Worksheets.Add

For x% = 1 To NumToGet%
GoBack:
RowNum% = 1 + Int(Rnd * LastRow%)

For y% = 1 To x% - 1
If RowNum% = AlreadyGot%(y) Then GoTo GoBack
Next y%

AlreadyGot(x) = RowNum%
Sheets(Sheets.Count - 1).Cells(x%, 1).Value = Worksheets("Data").Cells(RowNum%, 1).Value
Next x%

Erase AlreadyGot()

Exit Sub

Deal:
If Err = 9 Then
EndItAll = MsgBox("Please enter an integer between 0 and 32767.", vbCritical + vbOKOnly, "Error")
Exit Sub
Else
Resume Next
End If

End Sub
Repeats:
Private Sub cmdRepeat_Click()
Dim NumToGet As Integer
Dim LastRow As Integer
Dim RowNum As Integer

On Error GoTo Deal:

NumToGet% = InputBox("Return how many entries", "Input", "0")

LastRow% = 0
Do
LastRow% = LastRow% + 1
Loop Until Cells(LastRow%, 1).Value = ""
LastRow% = LastRow% - 1

ActiveWorkbook.Worksheets.Add

For x% = 1 To NumToGet%
RowNum% = 1 + Int(Rnd * LastRow%)
Sheets(Sheets.Count - 1).Cells(x%, 1).Value = Worksheets("Data").Cells(RowNum%, 1).Value
Next x%

Exit Sub

Deal:
If Err = 9 Then
EndItAll = MsgBox("Please enter an integer between 0 and 32767.", vbCritical + vbOKOnly, "Error")
Exit Sub
End If
If Err = 6 Then
EndItAll = MsgBox("Please enter an integer between 0 and 32767.", vbCritical + vbOKOnly, "Error")
Exit Sub
End If

Resume Next

End Sub
Edit: Whoops. Fixed a potential for overflow in the repeat option.

Renato
01-23-2009, 02:08 AM
Thks for the reply ,but the program in the end opens the new sheet but it doesn't inserts the values that have been randomly chosen from the original list.:(

crazymatt1
01-23-2009, 06:27 AM
I've attached the file. It seems to work fine for me.

Renato
01-23-2009, 07:09 AM
Thanks a lot crazymatt1...

It is working fine..

It is marked as solved..

Thanks