HELP=>What Is Wrong With This Code ?

T

tommo_blade

Hi, for the life of me I cannot see why this wont run, all it needs to
do is loop around a number of sheets in a workook and flag up when it
finds the correct one, the code fails at the "Instr" line, I have also
tried a staright "equals" match, it does not like the object
"Worksheets(x).Name":

WS = 0
For x = 1 To Worksheets.Count
'MsgBox "SHEET:" & Worksheets.Count

If InStr(1, Worksheets(x).Name, "Player List") <> 0 Then
MsgBox "FOUND PLAYER LIST:" & x
WS = x
End If
Next x

If WS = 0 Then
MsgBox "Unable to find 'Players List' worksheet"
Else

CODE GOES HERE



thanks..
 
D

Don Guillett

If you want to loop until finding the requested sheet and gothere and quit.

Sub findsheet()
For i = 1 To Sheets.Count
If UCase(Sheets(i).Name) = "PLAYER LIST" Then
Sheets(i).Select
Exit For
End If
Next i
End Sub
 
T

TomPl

It works for me, but I did define the variable "x" as "long" which might make
the difference.
 
J

Joel

the code works. therefore you must have the code in the wrong place. Make
sure the code is in a module sheet. Make sure you didn't put the code in a
different workbook or in a personal.xls module.
 
T

tommo_blade

that does not work either, now fails at the line with the "Ucase"
statement, I get the error when I select my worksheet, the vba code
behind the worksheets calls this piece of code.

the error is a run-time error '57121':
Application-defined or Object-defines error


Public Sub PopulateDropDowns()

Dim WS As Integer
Dim i As Integer
Dim y As Integer

WS = 0

For i = 1 To Sheets.Count
If UCase(Sheets(i).Name) = "PLAYER LIST" Then
Sheets(i).Select
'MsgBox "FOUND PLAYER LIST:" & Sheets(i).Name
WS = i
Exit For
End If
Next i

If WS = 0 Then
MsgBox "Unable to find 'Players List' worksheet"
Exit Sub
Else

==> CODE HERE <==

end Sub
 
D

Don Guillett

ONLY change where I have 'other code here. Delete my test line of
Range("e21").Value = 211

Sub findsheet()
Dim i As Long
For i = 1 To Sheets.Count
If UCase(Sheets(i).Name) = "PLAYER LIST" Then
Sheets(i).Select
Exit For
End If
Next i
Range("e21").Value = 211
'other code here
End Sub
 
T

TomPl

I can't make this code fail. I assume you have another "End If" following
the code. Maybe there is some conflict with the code underlying the
spreadsheet that calls this routine?
 
T

tommo_blade

Still the same, the full code I am using is immediately below and then
further down is the code which calls this procedure:


Public Sub PopulateDropDowns()

Dim WS As Integer
Dim i As Long
Dim y As Integer

WS = 0

For i = 1 To Sheets.Count
If UCase(Sheets(i).Name) = "PLAYER LIST" Then
Sheets(i).Select
'MsgBox "FOUND PLAYER LIST:" & Sheets(i).Name
WS = i
Exit For
End If
Next i

If WS = 0 Then
MsgBox "Unable to find 'Players List' worksheet"
Exit Sub
Else
For x = 1 To Worksheets.Count
If Left(Worksheets(x).Cells(1, 1), "Name") = 1 Then

Worksheets(x).KeepersListBox.Clear
Worksheets(x).DefendersListBox.Clear
Worksheets(x).MidfieldersListBox.Clear
Worksheets(x).StrikersListBox.Clear

y = 1
While (Worksheets(WS).Cells(y, 1)) <> ""
MyArray = Split(Worksheets(WS).Cells(y, 1), ":")
If MyArray(1) = "GOAL" Then
Worksheets(x).KeepersListBox.AddItem
MyArray(0) & " " & MyArray(2) & " " & MyArray(3)
End If
If MyArray(1) = "DEF" Then
Worksheets(x).DefendersListBox.AddItem
MyArray(0) & " " & MyArray(2) & " " & MyArray(3)
End If
If MyArray(1) = "MID" Then
Worksheets(x).MidfieldersListBox.AddItem
MyArray(0) & " " & MyArray(2) & " " & MyArray(3)
End If
If MyArray(1) = "STR" Then
Worksheets(x).StrikersListBox.AddItem
MyArray(0) & " " & MyArray(2) & " " & MyArray(3)
End If
y = y + 1
Wend
End If

Next x
End If

End Sub




-----------------------------------------------------------------------------------------------------------------------------------------------------------
calling code:

Public SelectedRow As Integer


Private Sub Worksheet_Activate()
Call PopulateDropDowns
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

Dim TeamCount As Integer

Dim myCols(12)
myCols(1) = "5"
myCols(2) = "7"
myCols(3) = "9"
myCols(4) = "11"
myCols(5) = "13"
myCols(6) = "15"
myCols(7) = "17"
myCols(8) = "19"
myCols(9) = "21"
myCols(10) = "23"
myCols(11) = "25"
myCols(12) = "27"

For i = 1 To 12
If Target.Column = myCols(i) Then
InputValue = Target.Value

If InputValue = "N" Then
Target.Interior.ColorIndex = 3
ElseIf InputValue > 0 Then
Target.Interior.ColorIndex = 38

Else
Target.Interior.ColorIndex = white
End If
End If
Next i

If Target.Column = 3 Then
For x = 8 To 18
TeamCount = 0
For y = 8 To 18
If Target.Worksheet.Cells(x, 3) =
Target.Worksheet.Cells(y, 3) And Target.Worksheet.Cells(x, 3) <> ""
Then
TeamCount = TeamCount + 1
End If
Next y

If TeamCount > 2 Then
Target.Worksheet.Cells(x, 3).Interior.ColorIndex = 3
Else
Target.Worksheet.Cells(x, 3).Interior.ColorIndex = 0
End If
Next x
End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

KeepersListBox.Visible = False
DefendersListBox.Visible = False
MidfieldersListBox.Visible = False
StrikersListBox.Visible = False

SelectedRow = Target.row

If Target.Column = 2 Then
If Target.row = 8 Then
KeepersListBox.Visible = True
KeepersListBox.Left = 150
End If
If Target.row > 8 And Target.row < 13 Then
DefendersListBox.Visible = True
DefendersListBox.Left = 150
End If
If Target.row > 12 And Target.row < 16 Then
MidfieldersListBox.Visible = True
MidfieldersListBox.Left = 150
End If
If Target.row > 15 And Target.row < 19 Then
StrikersListBox.Visible = True
StrikersListBox.Left = 150
End If
End If


If Target.row < 6 Then
If Target.Column = 2 Or Target.Column = 3 Then
ActiveSheet.Protect Password:="d0v3rs0l3",
UserInterfaceOnly:=False
ActiveSheet.Unprotect Password:="d0v3rs0l3"
End If
Else
ActiveSheet.Protect Password:="d0v3rs0l3",
UserInterfaceOnly:=True
End If

If Target.Column = 5 Or Target.Column = 7 Or Target.Column = 9 Or
Target.Column = 11 Or Target.Column = 13 _
Or Target.Column = 15 Then
If Target.row > 7 And Target.row < 19 Then
ActiveSheet.Protect Password:="d0v3rs0l3",
UserInterfaceOnly:=False
ActiveSheet.Unprotect Password:="d0v3rs0l3"
End If
End If

If Target.Column = 17 Or Target.Column = 19 Or Target.Column = 21
Or Target.Column = 23 _
Or Target.Column = 25 Or Target.Column = 27 Or Target.Column =
29 Then
If Target.row > 7 And Target.row < 13 Then
ActiveSheet.Protect Password:="d0v3rs0l3",
UserInterfaceOnly:=False
ActiveSheet.Unprotect Password:="d0v3rs0l3"
End If
End If

End Sub


Private Sub KeepersListBox_DblClick(ByVal Cancel As
MSForms.ReturnBoolean)
Dim MyFile As String
Dim x As Integer
Dim WS As Integer

WS = 0
For x = 1 To Worksheets.Count
If InStr(1, Worksheets(x).Cells(1, 1), "ARSENAL") <> 0 Then WS
= x
Next x

x = 1
While (Worksheets(WS).Cells(x, 1)) <> ""
MyArray = Split(Worksheets(WS).Cells(x, 1), ":")
Temp = Replace(Worksheets(WS).Cells(x, 1), ":", " ")
Temp = Replace(Temp, "GOAL ", "")
Temp = Replace(Temp, "DEF ", "")
Temp = Replace(Temp, "MID ", "")
Temp = Replace(Temp, "STR ", "")
If KeepersListBox.Value = Temp Then

ActiveSheet.Protect Password:="d0v3rs0l3",
UserInterfaceOnly:=False
ActiveSheet.Unprotect Password:="d0v3rs0l3"

Cells(SelectedRow, 2) = MyArray(2)
Cells(SelectedRow, 3) = MyArray(0)
Cells(SelectedRow, 4) = MyArray(3)

ActiveSheet.Protect Password:="d0v3rs0l3",
UserInterfaceOnly:=True

End If
x = x + 1
Wend

KeepersListBox.Visible = False
KeepersListBox.Left = 10000
End Sub

Private Sub DefendersListBox_DblClick(ByVal Cancel As
MSForms.ReturnBoolean)
Dim MyFile As String
Dim x As Integer
Dim WS As Integer

WS = 0
For x = 1 To Worksheets.Count
If InStr(1, Worksheets(x).Cells(1, 1), "ARSENAL") <> 0 Then WS
= x
Next x

x = 1
While (Worksheets(WS).Cells(x, 1)) <> ""
MyArray = Split(Worksheets(WS).Cells(x, 1), ":")
Temp = Replace(Worksheets(WS).Cells(x, 1), ":", " ")
Temp = Replace(Temp, "GOAL ", "")
Temp = Replace(Temp, "DEF ", "")
Temp = Replace(Temp, "MID ", "")
Temp = Replace(Temp, "STR ", "")
If DefendersListBox.Value = Temp Then

ActiveSheet.Protect Password:="d0v3rs0l3",
UserInterfaceOnly:=False
ActiveSheet.Unprotect Password:="d0v3rs0l3"

Cells(SelectedRow, 2) = MyArray(2)
Cells(SelectedRow, 3) = MyArray(0)
Cells(SelectedRow, 4) = MyArray(3)

ActiveSheet.Protect Password:="d0v3rs0l3",
UserInterfaceOnly:=True

End If
x = x + 1
Wend

DefendersListBox.Visible = False
DefendersListBox.Left = 10000
End Sub

Private Sub MidfieldersListBox_DblClick(ByVal Cancel As
MSForms.ReturnBoolean)
Dim MyFile As String
Dim x As Integer
Dim WS As Integer
Dim Temp As String

WS = 0
For x = 1 To Worksheets.Count
If InStr(1, Worksheets(x).Cells(1, 1), "ARSENAL") <> 0 Then WS
= x
Next x

x = 1
While (Worksheets(WS).Cells(x, 1)) <> ""
MyArray = Split(Worksheets(WS).Cells(x, 1), ":")
Temp = Replace(Worksheets(WS).Cells(x, 1), ":", " ")
Temp = Replace(Temp, "GOAL ", "")
Temp = Replace(Temp, "DEF ", "")
Temp = Replace(Temp, "MID ", "")
Temp = Replace(Temp, "STR ", "")
If MidfieldersListBox.Value = Temp Then

ActiveSheet.Protect Password:="d0v3rs0l3",
UserInterfaceOnly:=False
ActiveSheet.Unprotect Password:="d0v3rs0l3"

Cells(SelectedRow, 2) = MyArray(2)
Cells(SelectedRow, 3) = MyArray(0)
Cells(SelectedRow, 4) = MyArray(3)

ActiveSheet.Protect Password:="d0v3rs0l3",
UserInterfaceOnly:=True

End If
x = x + 1
Wend

MidfieldersListBox.Visible = False
MidfieldersListBox.Left = 10000

End Sub

Private Sub StrikersListBox_DblClick(ByVal Cancel As
MSForms.ReturnBoolean)
Dim MyFile As String
Dim x As Integer
Dim WS As Integer
Dim AWS As Integer

WS = 0
For x = 1 To Worksheets.Count
If InStr(1, Worksheets(x).Cells(1, 1), "ARSENAL") <> 0 Then WS
= x
Next x

x = 1
While (Worksheets(WS).Cells(x, 1)) <> ""
MyArray = Split(Worksheets(WS).Cells(x, 1), ":")
Temp = Replace(Worksheets(WS).Cells(x, 1), ":", " ")
Temp = Replace(Temp, "GOAL ", "")
Temp = Replace(Temp, "DEF ", "")
Temp = Replace(Temp, "MID ", "")
Temp = Replace(Temp, "STR ", "")

If StrikersListBox.Value = Temp Then

' If ActiveSheet.ProtectionMode = True Then
ActiveSheet.Protect Password:="d0v3rs0l3",
UserInterfaceOnly:=False
ActiveSheet.Unprotect Password:="d0v3rs0l3"
' End If

Cells(SelectedRow, 2) = MyArray(2)
Cells(SelectedRow, 3) = MyArray(0)
Cells(SelectedRow, 4) = MyArray(3)

ActiveSheet.Protect Password:="d0v3rs0l3",
UserInterfaceOnly:=True

' MsgBox ActiveSheet.ProtectionMode

End If
x = x + 1
Wend


StrikersListBox.Visible = False
StrikersListBox.Left = 10000

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VBA Coding Help for Beginner 0
MACRO Effeciency 3
Addition to current VBA - Keep text format 1
how to update a record from combo-box in user form? 0
Six columns randon no.'s no dupes 6
Unprotect sheet when Saving As 2
Code execution is correct but generates Error :The file you aretrying to open is in a different form 3
VBA to Find Key Words in Word doc then Extract Content to Excel.xlsm file 3

Top