I am trying to use a formula that it will allow me to pick 183 names randomly from a list of 355 names. My excel sheet will look something like this:
Names Random.Names
Paty
Oscar
John
Anna
Jane
Carlos
Maria
Jennifer
Susan
Kayla
On my actual sheet I have more names but this is just an example. I used the following formula but I have a few cells that show #REF after it randomizes.
=IF(ROWS($1:1)>$E$2,"",INDEX($A$8:$A$355,RANDBETWEEN(1,354)))
Please let me know if you have a better formula or if you know what I am doing wrong.
That is because INDEX is relative, so row 8 is 1 and row 355 is 355-8+1 = 348. Change the RANDBETWEEN to 1,348
Anything greater than the number of cells referenced will produce the error.
=IF(ROWS($1:1)>$E$2,"",INDEX($A$8:$A$355,RANDBETWEEN(1,348)))
Or you can reference the whole column and use 8,355:
=IF(ROWS($1:1)>$E$2,"",INDEX($A:$A,RANDBETWEEN(8,355)))
You do not have 355 names between A8 and A355 only 355-8+1.
So fix the RANDBETWEEN()
Following the logic of my previous anwser
You only have to open your VBA editor an paste the following code:
'By Julio Jesus Luna Moreno
'jlqmoreno#gmail.com
Option Base 1
Public Function UNIQRAND(a As Variant, b As Variant) As Variant
Application.Volatile
Dim k%, p As Double, flag As Boolean, x() As Variant
k = 1
flag = False
ReDim x(1)
x(1) = Application.RandBetween(a, b)
Do Until k = b - a + 1
Do While flag = False
Randomize
p = Application.RandBetween(a, b)
'Debug.Assert p = 2
resultado = Application.Match(p, x, False)
If IsError(resultado) Then
k = k + 1
ReDim Preserve x(k)
x(k) = p
flag = True
Else
flag = False
End If
Loop
flag = False
Loop
UNIQRAND = x
End Function
This function will do the trick
Public Function RANDNAMES(Rango As Range, HowMany As Integer) As Variant
Dim n, p(), x(), i As Variant
n = Rango.Rows.Count
If n < HowMany Then
MsgBox "Number of pairs must be less than number of total elements"
Exit Function
End If
ReDim x(HowMany)
ReDim p(n)
p = UNIQRAND(1, n)
For i = 1 To HowMany Step 1
x(i) = Application.Index(Rango, p(i))
Next i
Debug.Print HowMany
RANDNAMES = Application.Transpose(x)
End Function
Related
I have a table with several week ending dates at the top of each column. I want to search a row for any column with data in and then return, in a list, all the column titles that had data in.
I have attached a picture to better show what I mean, in the picture I have simply typed the dates in. I would like a formula, maybe VBA? that can do this for me but its proving more difficult than I thought.
What final result should look like
Really appreciate any help!
Thanks
** edit: I have found a formula which works but will be incredibly long. Surely there is a way to combine and shorten?
=IF(C5<>0,TEXT(C1,"dd/mm")&" | ","")&IF(D5<>0,TEXT(D1,"dd/mm")&" | ","")&IF(E5<>0,TEXT(E1,"dd/mm"),"")
The above code only works in 3 columns too... Not the required 60 plus!
Paste this code into a module, and in cell B2 type =IFERROR(getNonBlankCells($C$1:$K$1,C2:K2),"") and drag it down to B5.
Function getNonBlankCells(Rng1 As Range, Rng2 As Range) As Variant
Dim i As Integer, j As Integer, n As Integer, test As String
Dim A As Variant, B As Variant, ret(), newret(), t As Integer, p As Integer
n = Rng1.Columns.Count
ReDim ret(1 To n, 0)
A = Rng1.Value2
B = Rng2.Value2
i = 1
For j = 1 To n
If B(1, j) <> "" Then
ret(i, 0) = A(1, j)
i = i + 1
End If
Next j
ReDim newret(LBound(ret) To UBound(ret))
For t = LBound(ret) To UBound(ret)
If ret(t, 0) <> "" Then
p = p + 1
newret(p) = ret(t, 0)
End If
Next t
ReDim Preserve newret(LBound(newret) To p)
getNonBlankCells = Join(newret, ", ")
End Function
I have in Column K:
K8 is 6384 i.e. =SUM(J1:J8)
K9 is 2598 i.e. =SUM(J2:J9)
K10 is 12176 i.e =SUM(J3:J10)
:
:
K5488
up to K5488 (No numbers in sequence, all different numbers)
The largest number appearing in K is 1 400 000.
I need in Column M: The prime factors of each number in K
e.g. K8 is 6384 then M8 should be 2,2,2,2,3,7,19
k9 is 2598 then M9 should be 2,3,433 etc.
I found the following code by John Coleman on your site (Mar 28) which tested well, but seeing I have no programming knowledge, I don't know how to modify it to use in my columns K & M setup.
Here's the sample code:
Function Factor(ByVal n As Long, Optional FirstTrial As Long = 2) As String
Dim i As Long
Dim t As Long
Dim limit As Long
Dim rest As String
Dim s As String
If n = 1 Then
Factor = n
Exit Function
End If
limit = Int(Sqr(n))
t = FirstTrial
Do While t <= limit
If n Mod t = 0 Then
rest = Factor(n / t, t)
If rest <> "1" Then
s = t & "," & rest
End If
Factor = s
Exit Function
Else
If t = 2 Then t = 3 Else t = t + 2
End If
Loop
'if we get here:
Factor = n
End Function
Function PrimeOrFactor(n As Long) As String
Dim s As String
s = Factor(n)
If n = 1 Then
PrimeOrFactor = "Neither"
ElseIf (s) = Trim(n) Then
PrimeOrFactor = "Prime"
Else
PrimeOrFactor = s
End If
End Function
Tested like:
Sub test()
Dim i As Long
For i = 1 To 20
Cells(i, 1) = i
Cells(i, 2) = PrimeOrFactor(i)
Next i
End Sub
The function you provided is a udf (user defined function) to be used in your worksheet.
If you put the functions you provided in a normal code module, you can enter the following in your worksheet in M8:
=Factor(K8)
and copy that function down to your desired range.
I have data to reconcile between two system. one system might reported value 100 but on another system 50 two times.I need to consider them as possible match.
But not every record will have possible match
Column A Column B
SAP system Local system
100.00 50.00
435.00 50.00
146.25 435.00
53.75 253.50
I should conclude 100 has matching data (50 & 50) & 435 has matching data.I can match the exact one with formula but is there a way to match combination of values like 100.00 case?
This function will find the first matching pair and return the positions of the matching numbers in column B, called as:-
=FindPair(A2,B2:B5)
Option Explicit
Function FindPair(TotVal As Range, SearchVals As Range) As String
Dim Tot As Integer, i As Long, j As Long, length As Long, SearchVal As Double, found As Boolean
Dim store() As Double
Dim sum As Double
length = SearchVals.Rows.Count
ReDim store(length)
SearchVal = TotVal.Cells(1, 1).Value
For i = 1 To length
store(i) = SearchVals(i)
Next i
found = False
FindPair = ""
For i = 1 To length - 1
sum = store(i)
For j = i + 1 To length
If (sum + store(j)) = SearchVal Then
found = True
GoTo finish
End If
Next j
Next i
finish:
If found Then
FindPair = CStr(i) & "," & CStr(j)
End If
End Function
I have been banging my head (and a few other heads as well on other Excel programming sites) to get a Combobox in a Userform to sort the rows (coming from two columns in the source spreadsheet) in alpha order.
Ideally, I want a 2 dimensional sort, but at this point, will settle for ONE that works.
Currently, the Combobox, when dropped down, reads in part (minus the bullet points, which do NOT appear and are not needed):
Zoom MRKPayoutPlan
Chuck PSERSFuture
Chuck PSERSCurrent
What I want is:
Chuck PSERSCurrent
Chuck PSERSFuture
Zoom MRKPayoutPlan
The first order is derived from the order in which the rows appear in the source worksheet.
At this point, I am getting a Runtime Error '13', Type Mismatch error. Both fields are text fields (one is last name, the other is a classification code- I want to sort first by name).
Below are the two relevant sections of the VBA code. If someone can help me sort this out, I'll buy at least a virtual round of beers. Excel VBA is not my most comfortable area- I can accomplish this in other apps, but the client spec is that this all must run in Excel alone. Thanks in advance.
Private Sub UserForm_Initialize()
fPath = ThisWorkbook.Path & "\"
currentRow = 4
sheetName = Sheet5.Name
lastRow = Sheets(sheetName).Range("C" & Rows.Count).End(xlUp).Row
Dim rngUID As Range
Dim vList
Set rngUID = Range("vUID")
With rngUID
vList = Application.Index(.Cells, .Parent.Evaluate("ROW(" & .Address & ")"), Array(7, 1))
End With
vList = BubbleSort2D(vList, 2, 1)
With ComboBox1
.ColumnCount = 2
.ColumnWidths = "100;100"
.List = vList
End With
PopulateControls
End Sub
Public Function BubbleSort2D(Strings, ParamArray SortColumns())
Dim tempItem
Dim a As Long
Dim e As Long
Dim f As Long
Dim g As Long
Dim i As String
Dim j As String
Dim m() As String
Dim n
Dim x As Long
Dim y As Long
Dim lngColumn As Long
e = 1
n = Strings
Do While e <> -1
For a = LBound(Strings) To UBound(Strings) - 1
For y = LBound(SortColumns) To UBound(SortColumns)
lngColumn = SortColumns(y)
i = n(a, lngColumn)
j = n(a + 1, lngColumn)
f = StrComp(i, j)
If f < 0 Then
Exit For
ElseIf f > 0 Then
For x = LBound(Strings, 2) To UBound(Strings, 2)
tempItem = n(a, x)
n(a, x) = n(a + 1, x)
n(a + 1, x) = tempItem
Next x
g = 1
Exit For
End If
Next y
Next a
If g = 1 Then
e = 1
Else
e = -1
End If
g = 0
Loop
BubbleSort2D = n
End Function
Here is a bubble sort in VBA source.
Public Sub BubbleSort(ByRef sequence As Variant, _
ByVal lower As Long, ByVal upper As Long)
Dim upperIt As Long
For upperIt = upper To lower + 1 Step -1
Dim hasSwapped As Boolean
hasSwapped = False
Dim bubble As Long
For bubble = lower To upperIt - 1
If sequence(bubble) > sequence(bubble + 1) Then
Dim t as Variant
t = sequence(bubble)
sequence(bubble) = sequence(bubble + 1)
sequence(bubble + 1) = t
hasSwapped = True
End If
Next bubble
If Not hasSwapped Then Exit Sub
Next upperIt
End Sub
Note that using variable names that specify what they are and do instead of single letters makes it easier to read.
As for the 2D sort. Don't. Sort each array individually then sort the array of arrays using the same method. You will need to provide an abstraction to compare the columns. Do not try to sort them both at the same time. I can't think of a scenario where that is a good idea. If for some reason elements can change their sub array in the 2D array, then flatten it into 1 array, sort that and split it back into a 2D array.
Honestly from what I am understanding of you specific problem. You are going from 1D sequence to a 1D sequence so I think 2D arrays are and unnecessary complication.
Instead use a modified bubble sort routine with the comparison statement,
If sequence(bubble) > sequence(bubble +1) Then '...
replaced with a custom comparison function
ComboBoxItemCompare(sequence(bubble), sequence(bubble + 1))
that will return True if the first argument should be swapped with the second.
When I compare the value of a cell that contains ? to a variable, it always returns true. Is there any way I can prevent this? Here is my current code:
'Option Explicit
Dim hws As Worksheet
Set hws = ActiveSheet
Dim rng As Range, rng2 As Range
Dim letters(2, 2)
alpha = Range("CipherTable").Value
For x = 1 To 7
For y = 1 To 7
If alpha(x, y) = rng.Cells(i, j + 1).Value Then
letters(2, 1) = x
letters(2, 2) = y
End If
Next y
Next x
alpha, by the way, looks like this:
A B C D E F G
H I J K L M N
O P Q R S T U
V W X Y Z 1 2
3 4 5 6 7 8 9
0 ; : ' " . ,
( ) _ - + ? !
This always returns A, which is in alpha(1,1). Come to think of it, since they each go to seven, I don't know why it don't come back with !. How can I get around this and make it return true only when it actually matches?
As far as I understand you want to create a substitution algorithm. If there is no specific reason to use a two dimensional cipher table I would rather use a one dimensional approach like the following:
Function Cipher(Argument As String) As String
Dim Model As String
Dim Subst As String
Dim Idx As Integer
Dim MyPos As Integer
Cipher = ""
' note double quotation mark within string
Model = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890;:'"".,()_-+?!"
Subst = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890;:'"".,()_-+?!"
For Idx = 1 To Len(Argument)
' get position from Model
MyPos = InStr(1, Model, UCase(Mid(Argument, Idx, 1)))
' return character from substitution pattern
If MyPos <> 0 Then Cipher = Cipher & Mid(Subst, MyPos, 1)
Next Idx
End Function
calling this function with
Sub Test()
Debug.Print Cipher("The quick brown (?) fox 123 +-")
End Sub
results in THEQUICKBROWN(?)FOX123+- (because we don't allow blanks in Model or Subst)
Now change Subst to
Subst = "!?+-_)(,.""':;0987654321ZYXWVUTSRQPONMLKJIHGFEDCBA"
result is 4,_73.+'?6910GBF)9ZWVUCD
if you feed the above into the cipher function, you end up again with THEQUICKBROWN(?)FOX123+- as you would expect from a symetrical substitution.
I tried the following, and got the expected result (it was able to find the question mark):
(1) Created CipherTable range in worksheet, as above;
(2) Created a function QM similar to code above;
(3) Entered a formula in the style of =QM(cell-ref).
It worked fine. Function QM:
Public Function QM(theChar)
Dim CipherTable
Dim x As Integer
Dim y As Integer
CipherTable = Range("CipherTable").Value
For x = 1 To 7
For y = 1 To 7
If CipherTable(x, y) = theChar Then
QM = "X" & x & "Y" & y
Exit Function
End If
Next y
Next x
QM = ""
End Function
====
I also tried something more direct, and got the response expected:
Public Sub QM2()
Dim questMark As Range
Dim someChar As String
Set questMark = Range("CipherTable").Cells(7, 6)
someChar = "A"
Debug.Print questMark = someChar
End Sub