|
HELP=What Is Wrong With This Code ?
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.. |
HELP=What Is Wrong With This Code ?
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 -- Don Guillett Microsoft MVP Excel SalesAid Software "tommo_blade" wrote in message ... 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.. |
HELP=What Is Wrong With This Code ?
It works for me, but I did define the variable "x" as "long" which might make
the difference. "tommo_blade" wrote: 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.. |
HELP=What Is Wrong With This Code ?
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. "tommo_blade" wrote: 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.. |
HELP=What Is Wrong With This Code ?
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 |
HELP=What Is Wrong With This Code ?
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? "tommo_blade" wrote: 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 |
HELP=What Is Wrong With This Code ?
Still the same, the full code I am using is immediately below and then
further down is the code which calls this procedu 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 |
HELP=What Is Wrong With This Code ?
I am still not hanging up on the "if" statement. I am using Excel 2003.
"tommo_blade" wrote: Still the same, the full code I am using is immediately below and then further down is the code which calls this procedu 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" |
| All times are GMT +1. The time now is 12:41 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com