Eileen's Free Random Data Generator for Excel

[Rudi]

Hi,

I'm experimenting with creating a very small (and basic) random data generator and my only hurdle is trying to populate an array with the random data from the source sheet.
I have only little experience using/working with arrays and am stuck here?
Please assist. TX

Workbook attached. Just run the form from the Show Form button. Choosing OK will debug to the array error...

Northwind Sample Data.xlsm

Once I have the rows sorted, I can either delete the columns that was not checked in the dialog, or I can take another learning curve and deal with a direct dump from the array by modifying the column size too; which probably would be more ideal than deleting columns. Its all for learning and keeping in touch with my VBA skills.

BTW:... Idea!!
If this little random data generator is fully functional, then I would like to donate it to the lounge for anyone to use. It can even become a collaborative effort (like open source) for further developing it and providing it to the members as a free download for use. It would be cool (I think!!)

[HansV]

The check boxes current form are not suitable for easy processing. I renamed them chk1 to chk11 so that we can loop through them.
arrRecSet should be a two-dimensional array, and you should assign it element by element, not whole rows at a time.
You have to specify the array size before starting to populate it, but after calculating chkCount.
You have to assign the value of each cell to the array elements, not the cells (=objects) themselves.
Me.txtLocation is not a range but a string, so you must use Range(Me.txtLocation)
You should clear the sheet before (re-)populating it, and it's nice to resize the columns afterwards.

Code: Select all

Private Sub cmdCreateData_Click()
    Dim chkCol As Control
    Dim chkErr As Byte, chkCnt As Byte
    Dim i As Long, iRandRow As Long, j As Long, k As Long

    chkErr = 0
    chkCnt = 0

    '<<<CONTROL CHECKS>>>
    'Test if at least one checkbox is selected
    For Each chkCol In Me.grpSelectCols.Controls
        If chkCol.Value <> True Then
            chkErr = chkErr + 1
        Else
            chkCnt = chkCnt + 1
            'Exit For
        End If
    Next chkCol
    If chkErr = 11 Then
        MsgBox "You must select at least one column of sample data!", vbExclamation
        Exit Sub
    End If

    'Test is Location is valid
    If IsSingleCellAddress(Me.txtLocation) = False Then
        MsgBox "You must specify at valid cell address for the data dump!", vbExclamation
        Me.txtLocation.SetFocus
        Me.txtLocation.SelStart = 0
        Me.txtLocation.SelLength = Len(Me.txtLocation.Text)
        Exit Sub
    End If

    'Test if records returned amount is valid (number between 1(min) - 2000(max)
    If Me.txtRecAmount.Value < 1 Or _
        Me.txtRecAmount.Value > 2000 Then
        MsgBox "You must specify at value between 1 and 2000 for records to return!", vbExclamation
        Me.txtRecAmount.SetFocus
        Me.txtRecAmount.SelStart = 0
        Me.txtRecAmount.SelLength = Len(Me.txtRecAmount.Text)
        Exit Sub
    End If

    Unload Me

    '<<<POPULATE ARRAY>>>
    'Populate array with specified amount of random rows from source
    ReDim arrRecSet(1 To Me.txtRecAmount, 1 To chkCnt) As Variant
    For i = 1 To Val(Me.txtRecAmount)
        iRandRow = Application.WorksheetFunction.RandBetween(1, Me.txtRecAmount.Value)
        k = 0
        For j = 1 To 11
            If Me.Controls("chk" & j).Value = True Then
                k = k + 1
                arrRecSet(i, k) = ThisWorkbook.Worksheets("scrOrdList").Cells(iRandRow, j).Value
            End If
        Next j
    Next i

    ActiveSheet.Cells.ClearContents
    With Range(Range(Me.txtLocation), Range(Me.txtLocation).Resize(Me.txtRecAmount, chkCnt))
        .Value = arrRecSet
        .EntireColumn.AutoFit
    End With
End Sub

[HansV]

I forgot to attach the workbook, sorry:

Northwind Sample Data.xlsm

[Rudi]

OK...that is taking shape now...

Gosh, you identified quite a few more issues than I expected...
TX for the help on the array.

I'll study up what you did and continue to add/improve the code and functionality.
About clearing the sheet and formatting column widths...I hadn't even got there yet I was still just trying to get the data to the sheet.

I also have ideas to allow the user to determine where to place the data dump...New blank workbook, new sheet, existing sheet...
And I see I must update the code to exclude the header (and even have a prompt on the form to allow user to include a data header or exclude it).

2014-03-09_11h59_54.jpg

Lots to do...
and for you...

[HansV]

I'll let you work on that yourself first...

[Rudi]

Here is the latest version with some improvements and updates...

Any suggestions for additional functionality or improvements are welcome. See it as a mini open source project where interested parties can add/improve on it for all to use.
I would like to offer this simple Excel data generator to the members of this lounge once it is more or less finished. I plan to save it as an add-in and allow anyone to activate it in Excel for generating quick sample data for test purposes...

Current version so far:

Northwind Sample Data.xlsm

[HansV]

You currently select txtRecAmount row numbers at random between 2 and txtRecAmount. This guarantees that there will be duplicate records: if you select n items from a collection of n-1 items, they cannot be unique. Moreover, you'll get an error message if txtRecAmount = 1.

I would suggest that you always draw the row numbers from the entire recordset, and either ensure that you don't select the same row number twice, or add another option: whether repetitions are allowed or not.

[HansV]

Here is a version that selects unique random records. I also added two command buttons: Select All Columns and Invert Columns.

Northwind Sample Data.xlsm

[Rudi]

I haven't looked at it yet, but I am grateful for your input and modifications. i got busy with other things this afternoon, but during this time I was attempting to work on randomising the rows extracts. I found code to create random numbers and place it into an array...and I was trying to integrate the array into the row numbers code that extracted the data from the source...

Code: Select all

Function UniqueLongs()
Dim i As Long, n As Long
Dim numArray(2 To 2001) As Long
Dim numCollection As New Collection

    With numCollection
        For i = 2 To 2001
            .Add i
        Next
        For i = 2 To 2001
            n = Rnd * (.Count - 1) + 1
            numArray(i) = numCollection(n)
            .Remove n
        Next
    End With
    UniqueLongs = numArray()
End Function

And integrate like this...but it is not working yet...so your timely upload is welcome...

Code: Select all

'Populate array rows
    For lRow = 1 To Me.txtRecAmount
        lRandArray = Application.WorksheetFunction.Transpose(UniqueLongs)
        'lRandRow = Application.WorksheetFunction.RandBetween(2, Me.txtRecAmount.Value)
        lRandRow = lRandArray(lRow)
        lCol = 0
    'Populate array columns
        For lRandCol = 1 To 11
            If Me.Controls("chk" & lRandCol).Value = True Then
                lCol = lCol + 1
                arrRecSet(lRow, lCol) = ThisWorkbook.Worksheets("scrOrdList").Cells(lRandRow, lRandCol).Value
            End If
        Next lRandCol
    Next lRow

I have to go and wash my car now...before the sun sets....
I am eager to scan through your modified version though.

TX again!!

[Rudi]

I was planning to add a select all button; that was good thinking...but I do like your Invert selection button too. That one is great.

I still need to step through the code that generates the random record selection, but all in all...it is looking and working great!!
One other aspect that I want to improve is to change the clear all cells and rather test the area where the list goes to check if it will not overwrite cells, in the event that the list is added to a sheet that already contains data. Will work on this later.

[Rudi]

Here is version 1 of Eileen's Random Data Generator...Download and activate the add-in for some instant sample data for use with testing and other needs.

Once the add-in is installed, simply add a button to Excel's quick access toolbar to run the macro called: Eileens_RandomDataGenerator.
Running the macro will pop up the data form to prompt for input on how and where you want to create the random data.

Eileens Random Data Generator.zip

2014-03-09_19h52_05.jpg

[HansV]

To attach a non-supported file type such a .xlam, zip the file and attach the zip file...

[Rudi]

Hi,

I have converted the location text box into a ref_edit control to facilitate cell selection rather than typing a reference.
I now have the problem that when I select (for example) 3 cells (B1:D1) the array returns three columns of the source data, even though I attempted to extract only the first cell of the range in the IsSingleReference function.

How can I get the array to only return one column instead of the amount of columns selected in the ref_edit.
Note: If I select more columns from the check boxes than columns in the ref_edit, then it works fine... But left check boxes select and more columns in ref_edit results in a duplication of column info to fill ref_edit column count.

TX

Eileens Random Data Generator.xlsm

Selecing three columns in ref_edit

2014-03-10_09h10_59.jpg

Results in three columns of data returning??

2014-03-10_09h11_24.jpg

[Rudi]

Quick note:
OK...I see how I have complicated things...

First, the IsSingleCellAddress function is only a Boolean...and does not actually modify the txtLocation range/string to a single cell address. Problem #1
Second, the IF structure with the Dump labels is pathetic...because the ELSE statement will always run if I go back to the Dump label. (The condition is not being re-evaluated so it runs the true part and continues to run the else part too!! double

[Rudi]

I got rid of the Dump labels and fixed Issue #2 with this...

Code: Select all

    'Add data to worksheet
    If bAddHeader = True Then
        'Test if array dump will overwrite existing data at the dump range (incl headers)
        If Application.WorksheetFunction.CountA(Range(Range(Me.txtLocation), _
            Cells(UBound(arrRecSet, 1) + 1, UBound(arrRecSet, 2)))) = 0 Then
            Range(Range(Me.txtLocation), Range(Me.txtLocation).Resize(1, chkCnt)).Value = arrHeader
            With Range(Range(Me.txtLocation), Range(Me.txtLocation).Resize(Me.txtRecAmount, chkCnt)).Offset(1)
                .Value = arrRecSet
                .EntireColumn.AutoFit
            End With
        Else
            sWarn = MsgBox("Information on your worksheet will be overwritten by the data being returned!. Is this OK?", vbExclamation + vbYesNo)
            If sWarn = vbNo Then Exit Sub
            Range(Range(Me.txtLocation), Range(Me.txtLocation).Resize(1, chkCnt)).Value = arrHeader
            With Range(Range(Me.txtLocation), Range(Me.txtLocation).Resize(Me.txtRecAmount, chkCnt)).Offset(1)
                .Value = arrRecSet
                .EntireColumn.AutoFit
            End With
        End If
    Else
        'Test if array dump will overwrite existing data at the dump range (excl headers)
        If Application.WorksheetFunction.CountA(Range(Range(Me.txtLocation), _
            Cells(UBound(arrRecSet, 1), UBound(arrRecSet, 2)))) = 0 Then
            With Range(Range(Me.txtLocation), Range(Me.txtLocation).Resize(Me.txtRecAmount, chkCnt))
                .Value = arrRecSet
                .EntireColumn.AutoFit
            End With
        Else
            sWarn = MsgBox("Information on your worksheet will be overwritten by the data being returned!. Is this OK?", vbExclamation + vbYesNo)
            If sWarn = vbNo Then Exit Sub
            With Range(Range(Me.txtLocation), Range(Me.txtLocation).Resize(Me.txtRecAmount, chkCnt))
                .Value = arrRecSet
                .EntireColumn.AutoFit
            End With
        End If
    End If

So its just the array issue again...

[HansV]

You restrict rTarget to the first cell in the IsSingleCellAddress function, but that doesn't change the value of the txtLocation text box; the latter is used to dump the data. One option is to change the line

Code: Select all

    Set rTarget = Range(inputString).Cells(1)

back to

Code: Select all

    Set rTarget = Range(inputString)

Another option is to work with the first cell in the On Click event procedure of the cmdCreateData button:

Code: Select all

Private Sub cmdCreateData_Click()
    Dim chkCol As Control
    Dim chkErr As Byte, chkCnt As Byte
    Dim lRow As Long, lCol As Long, lRandRow As Long, lRandCol As Long
    Dim lRows As Long, i As Long, j As Long, k As Long, tmp As Long
    Dim arrHeader(1 To 11) As String, bAddHeader As Boolean
    Dim lWarn As Long ' not string!
    Dim rngTopLeftCell As Range

    chkErr = 0
    chkCnt = 0
    bAddHeader = False

    '<<<CONTROL CHECKS>>>
    'Test if at least one checkbox is selected
    For Each chkCol In Me.grpSelectCols.Controls
        If chkCol.Value <> True Then
            chkErr = chkErr + 1
        Else
            chkCnt = chkCnt + 1
            arrHeader(chkCnt) = Left(chkCol.Caption, InStr(1, chkCol.Caption, "(") - 2) ' & ","
        End If
    Next chkCol
    If chkErr = 11 Then
        MsgBox "You must select at least one column of sample data!", vbExclamation
        Exit Sub
    End If

    'Test is Location is valid
    If IsSingleCellAddress(Me.txtLocation) = False Then
        MsgBox "You must specify at valid cell address for the data dump!", vbExclamation
        Me.txtLocation.SetFocus
        Me.txtLocation.SelStart = 0
        Me.txtLocation.SelLength = Len(Me.txtLocation.Text)
        Exit Sub
    End If

    'Test if records returned amount is valid (number between 1(min) - 2000(max)
    If Me.txtRecAmount.Value < 1 Or _
        Me.txtRecAmount.Value > 2000 Then
        MsgBox "You must specify at value between 1 and 2000 for records to return!", vbExclamation
        Me.txtRecAmount.SetFocus
        Me.txtRecAmount.SelStart = 0
        Me.txtRecAmount.SelLength = Len(Me.txtRecAmount.Text)
        Exit Sub
    End If

    If Me.optHeaderYes = True Then bAddHeader = True
    If Me.optNewSh = True Then Worksheets.Add
    
    Unload Me

    '<<<POPULATE ARRAY>>>
    With ThisWorkbook.Worksheets("scrOrdList")
        lRows = .Range("A" & .Rows.Count).End(xlUp).Row
    End With
    ReDim arrRows(2 To lRows)
    For i = 2 To lRows
        arrRows(i) = i
    Next i
    For k = 1 To 5
        For i = 2 To lRows
            j = Application.RandBetween(2, lRows)
            tmp = arrRows(i)
            arrRows(i) = arrRows(j)
            arrRows(j) = tmp
        Next i
    Next k

    'Populate array with specified amount of random rows from source
    ReDim arrRecSet(1 To Me.txtRecAmount, 1 To chkCnt) As Variant
    'Populate array rows
    For lRow = 1 To Me.txtRecAmount
        lRandRow = arrRows(lRow + 1)
        lCol = 0
    'Populate array columns
        For lRandCol = 1 To 11
            If Me.Controls("chk" & lRandCol).Value = True Then
                lCol = lCol + 1
                arrRecSet(lRow, lCol) = ThisWorkbook.Worksheets("scrOrdList").Cells(lRandRow, lRandCol).Value
            End If
        Next lRandCol
    Next lRow

    'Add data to worksheet
    If bAddHeader = True Then
        'Test if array dump will overwrite existing data at the dump range (incl headers)
        Set rngTopLeftCell = Range(Me.txtLocation).Cells(1)
        If Application.WorksheetFunction.CountA(Range(rngTopLeftCell, _
            Cells(UBound(arrRecSet, 1) + 1, UBound(arrRecSet, 2)))) > 0 Then
            lWarn = MsgBox("Information on your worksheet will be overwritten by the data being returned!. Is this OK?", vbExclamation + vbYesNo)
            If lWarn = vbNo Then Exit Sub
        End If
        rngTopLeftCell.Resize(1, chkCnt).Value = arrHeader
        With rngTopLeftCell.Resize(Me.txtRecAmount, chkCnt).Offset(1)
            .Value = arrRecSet
            .EntireColumn.AutoFit
        End With
    Else
        'Test if array dump will overwrite existing data at the dump range (excl headers)
        If Application.WorksheetFunction.CountA(Range(rngTopLeftCell, _
            Cells(UBound(arrRecSet, 1), UBound(arrRecSet, 2)))) > 0 Then
            lWarn = MsgBox("Information on your worksheet will be overwritten by the data being returned!. Is this OK?", vbExclamation + vbYesNo)
            If lWarn = vbNo Then Exit Sub
        End If
        With rngTopLeftCell.Resize(Me.txtRecAmount, chkCnt)
            .Value = arrRecSet
            .EntireColumn.AutoFit
        End With
    End If
End Sub

BTW I still think you should clear the target sheet. There is no point in leaving (part of) the previous random sample in place.

[Rudi]

BTW I still think you should clear the target sheet. There is no point in leaving (part of) the previous random sample in place.

I was just thinking if the user wanted to add the sample data to an empty location on an existing sheet with content on it. In this event, it clears all the users content?

[HansV]

I see your point, but I don't like this situation:

S261.jpg

On the other hand, we might leave this to the user - it's his or her responsibility.

[BenCasey]

Hi Rudi,
How do I view the code. There is no Design View in my Excel 2010.
Thanks

[Rudi]

Hans:
I have re-evaluated the process and cleaned up the code. It works very well now and avoids overwriting data on a sheet with content.
Also, I have gone a different route with the selection of multiple cells in the Ref_Edit. I force a person to select only one cell. Seemed easier than to convert the string to a range, then calculate the first cell, etc...

There is only one more issue currently. I have this line in the Event code:

Code: Select all

    Me.txtLocation = Mid(Me.txtLocation, InStr(1, Me.txtLocation, "$"), InStr(1, Me.txtLocation, ":") - 1)

It is supposed to clean up the text string from the Ref_Edit, but it does not extract the reference??? In step into mode, it passes over the expression, but it does nothing...however, if I drag the yellow step into arrow back onto the expression, then it cleans up and extracts the reference?? Any ideas why it is not doing this on the first pass? If it can be fixed, it will solve the issue of the New Sheet option too. Currently if I choose New Sheet, it still dumps it on the initial sheet where the form was triggered.

Appreciate the help...as always.
Attached is the latest version....

Eileens Random Data Generator (V2.1).xlam.zip

Ben:
The code is under the Create Data button of the UserForm
If you open the Workbook, press ALT+F11
Double click on the folder called Forms in the VBA Projects Window (top left of VBA Editor)
Double click on frmSampleData (the userform)
Double click on the Create Data command button
It will open a Private Module with the code (which runs when the user clicks the button at run time)