• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Excel code extension needed

jhau1234

New Member
Hi,


I have the following code, provided by an expert from ExcelForum web site,which allows me to randomly choose numbers( as much required ) from a set of data available in column A.

[pre]
Code:
==============================================================

Sub test()
Dim myMax As Long, a, i As Long
myMax = [c2].Value
If myMax < 1 Then Exit Sub
With Cells(1).CurrentRegion.Offset(1)
.Columns("b").ClearContents
a = .Resize(, 2).Value
Randomize:
For i = 1 To UBound(a, 1) - 1
a(i, 2) = Rnd
Next
VSortM a, 1, UBound(a, 1) - 1, 2
.Columns(2).Resize(myMax).Value = a
End With
Call Choosen

End Sub

Private Sub VSortM(ary, LB, UB, ref)
Dim M As Variant, i As Long, ii As Long, iii As Long, temp
i = UB: ii = LB
M = ary(Int((LB + UB) / 2), ref)
Do While ii <= i
Do While ary(ii, ref) < M: ii = ii + 1: Loop
Do While ary(i, ref) > M: i = i - 1: Loop
If ii <= i Then
For iii = LBound(ary, 2) To UBound(ary, 2)
temp = ary(ii, iii): ary(ii, iii) = ary(i, iii)
ary(i, iii) = temp
Next
ii = ii + 1: i = i - 1
End If
Loop
If LB < i Then VSortM ary, LB, i, ref
If ii < UB Then VSortM ary, ii, UB, ref
End Sub

==============================================================
[/pre]
Now, I want an extension to this code. What I want is that the extended code should first search for the number 1234567899 in column A and if found should place the same in the result first & then pick rest of the numbers.If the number(1234567899) is not there in column A then the existing code should straight way get execute skipping the search for number 1234567899.Hope, I am able to make you understand what I wanted.
 
Hi ,


I have modified the code in the test procedure ; can you try it out and see if it works ?

[pre]
Code:
Sub test()
Const SEARCH_VAL = 1234567899
Dim myMax As Long, a, i As Long
'-------------------------------------------------------------------
a = Cells(1).CurrentRegion.Columns("A").Value

On Error Resume Next
i = Application.WorksheetFunction.Match(SEARCH_VAL, a, 0) '
On Error GoTo 0

If (i > 0) Then
temp = Range("A2").Value
Range("A2").Value = SEARCH_VAL
Range("A" & i).Value = temp
End If
'-------------------------------------------------------------------
myMax = [c2].Value
If myMax < 1 Then Exit Sub
With Cells(1).CurrentRegion.Offset(1)
.Columns("b").ClearContents
a = .Resize(, 2).Value
Randomize:
For i = 1 To UBound(a, 1) - 1
a(i, 2) = Rnd
Next

VSortM a, 2, UBound(a, 1) - 1, 2
.Columns(2).Resize(myMax).Value = a
End With
Call Choosen

End Sub
[/pre]
The VSortM procedure remains as it is.


Narayan
 
Back
Top