can u tidy this up

[MERKY]

the formula below might have some errors in it because when i try to execute it, i get this error message "For without text". Can you see what it is.

Sub Pairup()

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

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


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
Next y

If counter <> 0 Then
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 8 Or 16 Or 32 Or 64 Or 128 Or 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 8 Or 16 Or 32 Or 64 Or 128 Or 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

 

[kkknie]

Your statement:

For Each c In Range("C1:C" & x)

doesn't have a next.

Also, there is no need to use Next y (or Next anything) since VBA always assumes the next applies to the current For loop. Actually, code with large numbers of For/Next loops will run faster if you leave off the loop variables in the next statments.

Learned this in a VB class a few years ago...

K

 

[MERKY]

where excatly shall i write the "next"

 

[waderw]

missing "next" in:

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

YOU NEED A NEXT HERE

 

[MERKY]

now i get new problems.
if i press cancle when the inputbox appears i get this error message
"Method Range of object_Global failed

 

[Jay Petrulis]

Try,

Sub Pairup()

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

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 c

With Sheets("LIST")
.Columns("A:D").ClearContents
End With

If x = 0 Then
Sheets("Names").Select
Exit Sub
End If

counter = 0
For y = 0 To UBound(MyArr)
If CInt(x) = MyArr(y) Then counter = counter + 1
Next y

If counter <> 0 Then
Range("A1:A" & x) = "=RAND()"
Range("B1:B" & x) = "=RANK(RC[-1],C[-1])"
Range("C1:C" & x) = "=VLOOKUP(RC[-1],Names!R1C2:R[" & x - 1 & "]C3,2)"
Else: Application.Run "RANDOM"
End If

Range("C1:C" & x).Copy
Range("D1").PasteSpecial (xlValues)

With Sheets("Names")
.Range("H:H,J:J").ClearContents
End With

With Sheets("LIST")
.Range("D1:D" & x / 2).Copy Sheets("Names").Range("H1")
.Range("D" & (x  2) + 1 & ":D" & x).Copy Sheets("Names").Range("J1")
.Range("A1").Select
End With


End Sub

 

[waderw]

try this below the msgbox
if c = vbnullstring then exit for

or do a loop to prompt until a value is entered.

 

[waderw]

I'm sorry. Replace "c" with "x" and you might want to rename "x" to Response or something meaningful.

 

[MERKY]

If possible can someone try out the code Jay gave because it has some errors and i am not sure how to fix them.

 

[Jay Petrulis]

Hi Merky,

Looking at the code, I would move the test area up to the top (after the input box part).

Get the required number of x to pair and then you can write it to the sheet.

I will try it out with some dummy data.