HELP=>What Is Wrong With This Code ?

  • Thread starter Thread starter tommo_blade
  • Start date Start date
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..
 
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
 
It works for me, but I did define the variable "x" as "long" which might make
the difference.
 
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.
 
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
 
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
 
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?
 
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
 
Back
Top