i have this formula which works perfectly but when the user enters a incorrect number 2 times ,it gives me this message
"Please choose correct number of players to pair up".
Dont get me wrong, i still want it shown but i am just wondering, how come its not in the formula?
Sub Pairing_Up()
Dim x As Integer, counter As Integer, y As Integer, MyArr
Randomize
MyArr = Array(4, 8, 16, 32, 64, 128, 256)
On Error Resume Next
x = Application.InputBox("Would you like to pair up 4, 8, 16, 32, 64 or 128 or 256players" _
, "Enter number of players", 4, , , 1)
On Error GoTo 0
If x = 4 Or x = 8 Or x = 16 Or x = 32 Or x = 64 Or x = 128 Or x = 256 Then
Dim c
For Each c In Range("C1:C" & x)
If c = "" Then
MsgBox "Please enter data in cell " & c.Address
c.Select
Exit Sub
End If
Next
End If
Sheets("LIST").Select
Columns("A:D").Select
Selection.ClearContents
Range("A1").Select
If x = 0 Then Sheets("Names").Select
If x = 0 Then Exit Sub
counter = 0
For y = 0 To UBound(MyArr)
If CInt(x) = MyArr Then counter = counter + 1
Sheets("Names").Select
Next y
If counter<> 0 Then
Sheets("LIST").Select
Range("A1:A" & x) = "=RAND()"
Range("B1:B" & x) = "=RANK(RC[-1],C[-1])"
Else: Application.Run "RANDOM"
End If
If x = 4 Then
Range("C1").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!RC[-1]:R[3]C,2)"
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!R1C2:R[3]C3,2)"
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C4"), Type:=xlFillDefault
Range("C1:C4").Select
Range("D1").Select
End If
If x = 8 Then
Range("C1").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!RC[-1]:R[7]C,2)"
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!R1C2:R[7]C3,2)"
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C8"), Type:=xlFillDefault
Range("C1:C8").Select
Range("D1").Select
End If
If x = 16 Then
Range("C1").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!RC[-1]:R[15]C,2)"
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!R1C2:R[15]C3,2)"
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C16"), Type:=xlFillDefault
Range("C1:C16").Select
Range("D1").Select
End If
If x = 32 Then
Range("C1").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!RC[-1]:R[31]C,2)"
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!R1C2:R[31]C3,2)"
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C32"), Type:=xlFillDefault
Range("C1:C32").Select
Range("D1").Select
End If
If x = 64 Then
Range("C1").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!RC[-1]:R[63]C,2)"
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!R1C2:R[63]C3,2)"
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C64"), Type:=xlFillDefault
Range("C1:C64").Select
Range("D1").Select
End If
If x = 128 Then
Range("C1").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!RC[-1]:R[127]C,2)"
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!R1C2:R[127]C3,2)"
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C128"), Type:=xlFillDefault
Range("C1:C128").Select
Range("D1").Select
End If
If x = 256 Then
Range("C1").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!RC[-1]:R[255]C,2)"
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!R1C2:R[255]C3,2)"
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C256"), Type:=xlFillDefault
Range("C1:C256").Select
Range("D1").Select
End If
If x = 4 Or x = 8 Or x = 16 Or x = 32 Or x = 64 Or x = 128 Or x = 256 Then
Range("C1:C" & x).Select
Selection.Copy
Range("D1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("E1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ""
Range("F25").Select
End If
If x = 4 Or x = 8 Or x = 16 Or x = 32 Or x = 64 Or x = 128 Or x = 256 Then
Sheets("Names").Select
Range("H:H,J:J").Select
Range("J1").Activate
Selection.ClearContents
Range("D1").Select
Sheets("LIST").Select
Range("D1:D" & x / 2).Select
Selection.Copy
Sheets("Names").Select
Range("H1").Select
ActiveSheet.Paste
Sheets("LIST").Select
Range("D" & (x 2) + 1 & ":D" & x).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Names").Select
Range("J1").Select
ActiveSheet.Paste
Range("A1").Select
End If
End Sub
This message was edited by MERKY on 2002-05-03 08:59
"Please choose correct number of players to pair up".
Dont get me wrong, i still want it shown but i am just wondering, how come its not in the formula?
Sub Pairing_Up()
Dim x As Integer, counter As Integer, y As Integer, MyArr
Randomize
MyArr = Array(4, 8, 16, 32, 64, 128, 256)
On Error Resume Next
x = Application.InputBox("Would you like to pair up 4, 8, 16, 32, 64 or 128 or 256players" _
, "Enter number of players", 4, , , 1)
On Error GoTo 0
If x = 4 Or x = 8 Or x = 16 Or x = 32 Or x = 64 Or x = 128 Or x = 256 Then
Dim c
For Each c In Range("C1:C" & x)
If c = "" Then
MsgBox "Please enter data in cell " & c.Address
c.Select
Exit Sub
End If
Next
End If
Sheets("LIST").Select
Columns("A:D").Select
Selection.ClearContents
Range("A1").Select
If x = 0 Then Sheets("Names").Select
If x = 0 Then Exit Sub
counter = 0
For y = 0 To UBound(MyArr)
If CInt(x) = MyArr Then counter = counter + 1
Sheets("Names").Select
Next y
If counter<> 0 Then
Sheets("LIST").Select
Range("A1:A" & x) = "=RAND()"
Range("B1:B" & x) = "=RANK(RC[-1],C[-1])"
Else: Application.Run "RANDOM"
End If
If x = 4 Then
Range("C1").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!RC[-1]:R[3]C,2)"
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!R1C2:R[3]C3,2)"
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C4"), Type:=xlFillDefault
Range("C1:C4").Select
Range("D1").Select
End If
If x = 8 Then
Range("C1").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!RC[-1]:R[7]C,2)"
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!R1C2:R[7]C3,2)"
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C8"), Type:=xlFillDefault
Range("C1:C8").Select
Range("D1").Select
End If
If x = 16 Then
Range("C1").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!RC[-1]:R[15]C,2)"
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!R1C2:R[15]C3,2)"
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C16"), Type:=xlFillDefault
Range("C1:C16").Select
Range("D1").Select
End If
If x = 32 Then
Range("C1").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!RC[-1]:R[31]C,2)"
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!R1C2:R[31]C3,2)"
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C32"), Type:=xlFillDefault
Range("C1:C32").Select
Range("D1").Select
End If
If x = 64 Then
Range("C1").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!RC[-1]:R[63]C,2)"
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!R1C2:R[63]C3,2)"
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C64"), Type:=xlFillDefault
Range("C1:C64").Select
Range("D1").Select
End If
If x = 128 Then
Range("C1").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!RC[-1]:R[127]C,2)"
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!R1C2:R[127]C3,2)"
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C128"), Type:=xlFillDefault
Range("C1:C128").Select
Range("D1").Select
End If
If x = 256 Then
Range("C1").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!RC[-1]:R[255]C,2)"
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Names!R1C2:R[255]C3,2)"
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C256"), Type:=xlFillDefault
Range("C1:C256").Select
Range("D1").Select
End If
If x = 4 Or x = 8 Or x = 16 Or x = 32 Or x = 64 Or x = 128 Or x = 256 Then
Range("C1:C" & x).Select
Selection.Copy
Range("D1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("E1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ""
Range("F25").Select
End If
If x = 4 Or x = 8 Or x = 16 Or x = 32 Or x = 64 Or x = 128 Or x = 256 Then
Sheets("Names").Select
Range("H:H,J:J").Select
Range("J1").Activate
Selection.ClearContents
Range("D1").Select
Sheets("LIST").Select
Range("D1:D" & x / 2).Select
Selection.Copy
Sheets("Names").Select
Range("H1").Select
ActiveSheet.Paste
Sheets("LIST").Select
Range("D" & (x 2) + 1 & ":D" & x).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Names").Select
Range("J1").Select
ActiveSheet.Paste
Range("A1").Select
End If
End Sub
This message was edited by MERKY on 2002-05-03 08:59