Update a range within a macro using an input box or similar

[John]

I am really new to VBA. I am building a tool that extracts random records
using the row numbers in Excel. The random numbers are generated by an
outside source and come in the format '123, 456, 789'

I've created a code that exctracts rows 123, 456, 789.

'///////////CODE BEGINS HERE/////////////
Range("A123,A456,A789").EntireRow.Copy
Sheets("Sample").Select
ActiveSheet.Range("A1").Select
ActiveCell.PasteSpecial (xlPasteValuesAndNumberFormats)
Application.CutCopyMode = False
End Sub
'//////////CODE ENDS HERE//////////////////

To get to this point requires a lot of massaging of the numbers in VBA
(adding the 'A' and removing the spaces) usually using global search and
replace. This is simple enough for me, but not simple enough for some end
users.

I want to use an input box or other pop-up type tool imbedded in the macro
that allows the user to input the numbers as a group (copy and paste in one
step) in the format supplied to them (e.g. '123, 456, 789') that will
automatically convert them to the correct format (e.g. 'A123,A456,A789') and
then update the RANGE line of the macro built above before the macro
continues past this point.

Any help will be appreciated.

Thanks,

 

[Ken Johnson]

Hi John,
What about random numbers less than 100 are they formatted like this:
'001, 023, 456' ?
And, is the single space after each comma guaranteed?
Ken Johnson

 

[Mike Fogleman]

Here is some code for no spaces in the user input:
Sub CopyRandom()
Dim a As String, b As String, c As String
Dim mystring As String
Dim newrng As Range

mystring = InputBox("Enter numbers as xxx,xxx,xxx")
a = Left(mystring, 3) & ":" & Left(mystring, 3)
b = Mid(mystring, 5, 3) & ":" & Mid(mystring, 5, 3)
c = Right(mystring, 3) & ":" & Right(mystring, 3)
mystring = a & "," & b & "," & c
Set newrng = Range(mystring)
newrng.Copy
Sheets("Sample").Range("A1").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
End Sub

Mike F

 

[Ken Johnson]

Hi John,
Doesn't matter about the first question, I've just noticed that
Range("A001") works just as well as Range("A1").
Ken Johnson

 

[voodooJoe]

John -

No reason to use the 'A' in the addresses or to .Select or .Activate. In
fact, you want to use these this as little as you possibly can.
Select and Activate will really slooow things down.

Here are 2 solutions - both get the data from user in an input box where
they enter the numbers like: 123,456,789. Spaces don't matter but they need
to be comma deliminated


this will introduce you to:
arrays, range object, do loop, application object, union worksheet
function, codename
look these up in XL help for more info

cheers - voodooJoe

Sub X1()
Dim strRows$, c%, ayRows(), rng As Range

'this one uses a redimensionable array to store row numbers and then creates
the array of rows

'using inlut box to get values - better to have code read the data if you
can
strRows = Application.InputBox("Rows - comma deliminate")
' if user put in no numbers the macro dumps. should probably check for
a cancel also
If Len(strRows) > 0 Then ReDim ayRows(1 To 1) Else Exit Sub

Do
c = InStr(1, strRows, ",") 'looks for a comma in the list of rows, c
is the position of the first comma; returns 0 is no comma present
If c = 0 Then
ayRows(UBound(ayRows)) = strRows 'if no comma found c = shoe
string -- that is 1 number
Exit Do == this will always be the last number in the set so we
can exit
Else
ayRows(UBound(ayRows)) = Left(strRows, c - 1) 'if comma found,
read all# to the left
ReDim Preserve ayRows(1 To UBound(ayRows) + 1)'set the next
array elem,ent
strRows = Right(strRows, Len(strRows) - c)'trim away the
characters we read
End If
Loop

Set rng = Sheet1.Rows(ayRows(1))'set the range to something

For i = 1 To UBound(ayRows)
Set rng = Application.Union(rng, Sheet1.Rows(ayRows(i)))'set the
range to the union of the old range and the new one
Next i
rng.Copy Sheet2.Cells(1, 1)'copy andpaste

End Sub

'i like this one better.

Sub X2()
Dim strRows, rng, c%, t%

'same get value and test
strRows = Application.InputBox("Rows - comma deliminate")
If Len(strRows) = 0 Then Exit Sub

'we initially don't know the rows we want to copy
Set rng = Nothing

Do

'look for the comma
c = InStr(1, strRows, ",")

'if there is no comma, then T is the whole string (plus 1 character)
if there is a comma, we only want up to the comma
If c = 0 Then t = Len(strRows) + 1 Else t = c


If rng Is Nothing Then'this is the first row in the set where we
haven't set rng equal to anything yet
Set rng = Sheet1.Rows(Left(strRows, t - 1))
Else
Set rng = Application.Union(rng, Sheet1.Rows(Left(strRows, t -
1)))'if rng already has a value, we append the new row to the rolds ones
End If
strRows = Right(strRows, Len(strRows) - c)'trim down the string

Debug.Print rng.Address & " ... " & strRows'shows you the progress.
delete in final code

Loop While c <> 0'loop; while there still are commas

rng.Copy Sheet2.Cells(1, 1)'copy paste

End Sub

 

[Richard Mücke]

Hi John,

the following code is just for converting "123, 456,789, 17655" to
"A123,A456,A789,A17655":


Sub BuildRange()
Dim xarray

' This is what you get from the user input
xinput = "123, 456,789, 17655"
' split the input (each "," will split the input)
xarray = Split(xinput, ",")
' Then trim each element to kill possible spaces and add an "A"
For i = 0 To UBound(xarray)
xarray(i) = "A" & Trim(xarray(i))
Next i

' Now create the output string
xoutput = Join(xarray, ",")
' xoutput will be: "A123,A456,A789,A17655"

End Sub

Now you can use your code with the created range:
Range(xoutput).EntireRow.Copy
and so on...

Did you mean something like this?

Greets, Richard.

 

[John]

Voodoo - You are awesome, but I need a little more help. I went with your
second suggestion and it worked. HOWEVER, there seems to be a limit to the
number of charachters (~ 100) that can be input into the InputBox. Is there
any way around this? I am often pulling samples the size of 6500 at five to
seven digits each.
Thanks for all your effort so far and I hope you can continue with this.

 

[voodooJoe]

John -

there are LOTS of ways better than input boxes ( BTW - i really don't like
to use them except for myself as the data entry os very difficult to control
= lots of error checking)

the best answer depends on (a) how the random numbers are generated (b)
where and what form the randoms are in.
take a look at a few options and let me know what best fits your situation -
or create your own from these ideas and i'd be glad to help

you could: (from most user effort to the least)

Option A
create a user form that lets the user enter 1 row# at a time in a text box
hitting "ADD" button adds the number to a list box (visible to the user on
the form)
hitting "DONE" button closes form and runs loop
(I call this the "Thank you, Sir. May I have another" Option)

Option B
type in or manually import numbers to a range on a worksheet - let XL then
loop through the list

Option C
depending on where the numbers are, import them using vba and run the loop

Option D
give XL the low and high row numbers and the number of samples you want --
then let XL's random number generator
select the rows for you

{Why do I get the feeling you're gonna pick C?}

- voodooJoe

 

[John]

Option D is out as I hear that Excel has a problem with the RNG.

C looks enticing but I get them from a website. www.randomizer.org (free
site BTW) It spits out a page with the Random numbers which I would like to
copy and paste, BUT it will also download to Excel. The Excel download
creates a file with one number per cell arranged in a column (A) strarting
in cell A5

Because it downloads to Excel I think it may be best to go with option B.
The range would be dynamic as the sample is different every time. I would
like to keep the worksheet that the list (range) is on seperate from the
source and output worksheets that are involved in the macro you already
built. You see I do sampling a lot and will get a lot of use from this* and
would like a master file that I would open and manually import the downloaded
Randomizer.com worksheet into and then I could execute the macro.

*(so I can't express my appreciation enough)

Thanks for your help

 

[voodooJoe]

Actually, John, pick C.

The fact that the randomizer will auto generate a spreadsheet (in the same
format everytime) is a boon.
Be warned - you are creating a model based on a free service that COULD
cease to exist at any moment! Not that it will, but it is a risk.
In that case, you;d have to figure out a different way to create #s

The RNG site will create a spreadsheet that looks like this:

Research Randomizer Results:
10 Sets of 50 Unique Numbers Per Set
Range: From 1 to 1000 -- Sorted
Set 1 Set 2

I'd suggest you visit the site and create a 'period's worth of randomnumber
sets. Conveniently define 'period' as you will - month, quarter, year - but
no more than 250 unique sets.
This means that you can create 1 sheet with up to 250 sets of random numbers
and read off that sheet for a very long time. When you need to, create
another sheet of number sets.
This way you also have an archive of the number sets you used - and can
prove that, over time, they are random.

the strategy then is to:

identify the file w/ the random sets (we'll call it "random.xls")
get the set of numbers you want to use into an array
use the array in the rest of your routine - actually VERY simplified from
what you did before

this requires a minimal amount of setup on the random.xls file
1. go to the website and create a workbook of X sets of Y numbers -
whatever floats your boat and save it to your hard drive
2. open random.xls and do 2 things:
** take the spaces out of the "Set 1", "Set 2" ... headings
** highlight the while table of Set headings and random numbers and
give the range a name (I used 'sets')
3. save and close the file

Sub RecordsetExample()
Dim SourceFile$, SourceRange$, GetSet%
Dim rst As ADODB.Recordset, sConn$, sSQL$
Dim RandomNumberArray As Variant
Dim rng As Range

' requires a reference to the Microsoft ActiveX Data Objects library
' in VBA module, click Tools/References

'this is the source file name - read it from a cell or input box, stash
it in a custom doc property etc.
'google for getopenfilename if you want to make it dynamic
SourceFile = "C:\Documents and Settings\voodooJoe\Desktop\random.xls"
'this is the range name - you could hard code, store or get form input
box
SourceRange = "sets"

'this is the set # you want. i suggest you stash this in the workbook.
i like custom document properties
'add one BEFORE you run the code thru clicking file/properties/custom
With ThisWorkbook.CustomDocumentProperties("setnumber")
GetSet = .Value
.Value = .Value + 1 'increment the set by one
'good idea to put eror handling here so you dont go over the # of
sets in your random.xls file
End With

' Create a new recordset object
Set rst = New ADODB.Recordset
' Connection details string
sConn = "DRIVER={Microsoft Excel Driver (*.xls)};" & "ReadOnly=1;DBQ=" &
SourceFile
' SQL statement to retrieve list of numbers
sSQL = "SELECT Set" & GetSet & " FROM " & SourceRange
' Open the recordset
rst.Open sSQL, sConn

'put the recordset into zero based array with all your random numbers in
it
'to read array is RandomNumberArray(0,0), RandomNumberArray(0,1) etc.
RandomNumberArray = rst.GetRows

' Clean up
rst.Close
Set rst = Nothing

'NOW EVERYTHING YOU WERE DOING BEFORE IS BOILED DOWN TO 5 LINES!

Set rng = Sheet1.Rows(RandomNumberArray(0, 0))

For i = 1 To UBound(RandomNumberArray, 2)
Set rng = Application.Union(rng, Sheet1.Rows(RandomNumberArray(0,
i)))
Next i

rng.Copy Sheet3.Cells(1, 1) 'copy paste

'clean up
Set rng = Nothing

End Sub

 

[John]

voodoo - I was away from this project for a while. I have implemented C as
you wrote it. It works great. I will be looking for the file open code so I
can share this with others. Thanks for all your help on this.

 

[John]

I'm back because this has stopped working for me. I get a type mismatch
error. I can only think o f the file/properties/custom modification and have
tried it as number and text. Any ideas as to why this is not working?

Thanks,
John

My VBA Code:
Sub RecordsetExample()
Dim SourceFile$, SourceRange$, GetSet%
Dim rst As ADODB.Recordset, sConn$, sSQL$
Dim RandomNumberArray As Variant
Dim rng As Range

' requires a reference to the Microsoft ActiveX Data Objects library
' in VBA module, click Tools/References

'this is the source file name - read it from a cell or input box, stash
it in a custom doc property etc.
'google for getopenfilename if you want to make it dynamic
SourceFile = "C:\Documents and Settings\myname2\My Documents\Sample
Extractor\random.xls"
'this is the range name - you could hard code, store or get form input box
SourceRange = "sets"

'this is the set # you want. i suggest you stash this in the workbook.
i like custom document properties
'add one BEFORE you run the code thru clicking file/properties/custom
With ThisWorkbook.CustomDocumentProperties("setnumber")
GetSet = .Value
.Value = .Value + 1 'increment the set by one
'good idea to put eror handling here so you dont go over the # of
sets in your random.xls file
End With

' Create a new recordset object
Set rst = New ADODB.Recordset
' Connection details string
sConn = "DRIVER={Microsoft Excel Driver (*.xls)};" & "ReadOnly=1;DBQ=" &
SourceFile
' SQL statement to retrieve list of numbers
sSQL = "SELECT Set" & GetSet & " FROM " & SourceRange
' Open the recordset
rst.Open sSQL, sConn

'put the recordset into zero based array with all your random numbers in
it
'to read array is RandomNumberArray(0,0), RandomNumberArray(0,1) etc.
RandomNumberArray = rst.GetRows

' Clean up
rst.Close
Set rst = Nothing

'NOW EVERYTHING YOU WERE DOING BEFORE IS BOILED DOWN TO 5 LINES!

Set rng = Sheet1.Rows(RandomNumberArray(0, 0))

For i = 1 To UBound(RandomNumberArray, 2)
Set rng = Application.Union(rng, Sheet1.Rows(RandomNumberArray(0, i)))
Next i

rng.Copy Sheet2.Cells(1, 1) 'copy paste

'clean up
Set rng = Nothing

End Sub

 

[John]

VooDoo (or anyone with some experience with this)

After working for me for the longest time, I am now getting a Visual basic
Error when running the code detailed below.
ERROR:
Run-time error '-2147217904 (80040e10)'
[Microsoft][ODBC Excel Driver] Too few parameters. Expected 1.

Clicking on DEBUG brings me to the following line of code:
rst.Open sSQL, sConn

Are there any ideas on solutions? Thanks in advance.

/////ENTIRE CODE BEGINS HERE/////
Sub VooDoo()

Dim SourceFile$, SourceRange$, GetSet%
Dim rst As ADODB.Recordset, sConn$, sSQL$
Dim RandomNumberArray As Variant
Dim rng As Range

' requires a reference to the Microsoft ActiveX Data Objects library
' in VBA module, click Tools/References

'this is the source file name - read it from a cell or input box, stash it
in a custom doc property etc.
'google for getopenfilename if you want to make it dynamic
SourceFile = "C:\Documents and Settings\user2\My
Documents\RandomTool\random.xls"
'this is the range name - you could hard code, store or get form input box
SourceRange = "sets"

'this is the set # you want. i suggest you stash this in the workbook. I
like custom document properties
'add one BEFORE you run the code thru clicking file/properties/custom
With ActiveWorkbook.CustomDocumentProperties("setnumber")
GetSet = .Value
..Value = .Value + 1 'increment the set by one
'good idea to put error handling here so you dont go over the # of sets in
your random.xls file
End With

'Create a new recordset object
Set rst = New ADODB.Recordset
'Connection details string
sConn = "DRIVER={Microsoft Excel Driver (*.xls)};" & "ReadOnly=1;DBQ=" &
SourceFile
'[TRIED]sConn = "DRIVER={Microsoft Excel Driver (*.xls)};" &
"ReadOnly=1;DBQ=" & "C:\Documents and Settings\user2\My
Documents\RandomTool\random.xls"
'[TRIED]sConn = "Provider=Microsoft.Jet.OLEDB.4.0; & "ReadOnly=1;DBQ=" &
SourceFile
' SQL statement to retrieve list of numbers
sSQL = "SELECT Set" & GetSet & " FROM " & SourceRange
' Open the recordset
rst.Open sSQL, sConn

'put the recordset into zero based array with all your random numbers in it
'to read array is RandomNumberArray(0,0), RandomNumberArray(0,1) etc.
RandomNumberArray = rst.GetRows

'Clean up
rst.Close
Set rst = Nothing

'NOW EVERYTHING YOU WERE DOING BEFORE IS BOILED DOWN TO 5 LINES!

Set rng = Sheet1.Rows(RandomNumberArray(0, 0))

For i = 1 To UBound(RandomNumberArray, 2)
Set rng = Application.Union(rng, Sheet1.Rows(RandomNumberArray(0, i)))
Next i

rng.Copy Sheet3.Cells(1, 1) 'copy paste

'clean up
Set rng = Nothing

End Sub
///////CODE ENDS HERE//////