|
Annoying Problem - Subscript out of range
Anthony wrote:
Hi, The problem I am having is only occurring on 2 pc's. I have run the code on numerous other machines with no issues, but the annoying thing is I need it to run it on one of the pc's that is having the subscript out of range error. I have attached the two spreadsheets. The master file is meant to open up the office file and load in any information. The code is written so the user can select multiple files and it will work its way through them. The code is not very fancy but it was something I was putting together in a hurry and I was going to go back through the code and clean it up etc. What I don't understand is on the machines it failed on, the code in module 2 (Button2_click) fails during the function; e.g (sample of what I have descriped) fname="Tracker file" Workbooks.open(fname) 'ok Workbooks(fname).sheets("sheet1").select 'fails - subscript out of range Any help would be gratefully received. I apologise for having to attach files. Anthony p.s password is dragon1 different regional setting and "sheet1" is not "sheet1" ? |
Annoying Problem - Subscript out of range
How do I get around this?
"witek" wrote in message ... Anthony wrote: Hi, The problem I am having is only occurring on 2 pc's. I have run the code on numerous other machines with no issues, but the annoying thing is I need it to run it on one of the pc's that is having the subscript out of range error. I have attached the two spreadsheets. The master file is meant to open up the office file and load in any information. The code is written so the user can select multiple files and it will work its way through them. The code is not very fancy but it was something I was putting together in a hurry and I was going to go back through the code and clean it up etc. What I don't understand is on the machines it failed on, the code in module 2 (Button2_click) fails during the function; e.g (sample of what I have descriped) fname="Tracker file" Workbooks.open(fname) 'ok Workbooks(fname).sheets("sheet1").select 'fails - subscript out of range Any help would be gratefully received. I apologise for having to attach files. Anthony p.s password is dragon1 different regional setting and "sheet1" is not "sheet1" ? |
Annoying Problem - Subscript out of range
Anthony wrote:
How do I get around this? check codename of this worksheet. It is (Name) property in properties (in VBE) . Probably it is Sheet1 or something around that and write. Workbooks(fname).Sheet1.select "witek" wrote in message ... Anthony wrote: Hi, The problem I am having is only occurring on 2 pc's. I have run the code on numerous other machines with no issues, but the annoying thing is I need it to run it on one of the pc's that is having the subscript out of range error. I have attached the two spreadsheets. The master file is meant to open up the office file and load in any information. The code is written so the user can select multiple files and it will work its way through them. The code is not very fancy but it was something I was putting together in a hurry and I was going to go back through the code and clean it up etc. What I don't understand is on the machines it failed on, the code in module 2 (Button2_click) fails during the function; e.g (sample of what I have descriped) fname="Tracker file" Workbooks.open(fname) 'ok Workbooks(fname).sheets("sheet1").select 'fails - subscript out of range Any help would be gratefully received. I apologise for having to attach files. Anthony p.s password is dragon1 different regional setting and "sheet1" is not "sheet1" ? |
Annoying Problem - Subscript out of range
This is the actual code;
Sub Button2_Click() ' ' Button2_Click Macro ' Macro recorded 21/05/2006 by Anthony & Ehly ' ' Dim OpenFilename As Variant Dim a, b, c, d, e As Integer Dim fname, officename As String Dim nocount As Integer On Error GoTo error Application.EnableEvents = False Application.ScreenUpdating = False OpenFilename = Application.GetOpenFilename("Excel Files (*.xls),*.xls", , "Open tracker files", , True) If IsArray(OpenFilename) Then For a = LBound(OpenFilename) To UBound(OpenFilename) Workbooks.Open (OpenFilename(a)) For b = 1 To Len(OpenFilename(a)) If (Mid$(OpenFilename(a), b, 1) = "\") Then c = b End If Next b fname = Right$(OpenFilename(a), Len(OpenFilename(a)) - c) fname = Left$(fname, Len(fname) - 4) Application.ThisWorkbook.Sheets("sheet1").Visible = True e = Application.ThisWorkbook.Sheets("sheet1").Cells(1, 1).Value + 2 If (Workbooks(fname).Sheets("sheet1").Cells(1, 2).Value = 492507) Then Workbooks(fname).Sheets("sheet1").Visible = True d = Workbooks(fname).Sheets("sheet1").Cells(1, 1).Value officename = Workbooks(fname).Sheets("sheet1").Cells(1, 3).Value If (d 0) Then Workbooks(fname).Sheets("sheet1").Select Range(Cells(2, 1), Cells(d + 1, 5)).Select Selection.Copy Application.ThisWorkbook.Activate Sheets("sheet1").Select Cells(Sheets("sheet1").Cells(1, 1).Value + 2, 1).Select ActiveSheet.Paste 'copy front page Workbooks(fname).Activate Sheets("absence").Select Range("A2:B" & (d + 1)).Select Selection.Copy Application.ThisWorkbook.Activate Sheets("absence").Select Range("B" & e & ":C" & (e + d - 1)).Select Selection.PasteSpecial Paste:=xlPasteValues Workbooks(fname).Activate Sheets("absence").Select Range("D2:D" & (d + 1)).Select Selection.Copy Application.ThisWorkbook.Activate Sheets("absence").Select Range("E" & e & ":E" & (e + d - 1)).Select Selection.PasteSpecial Paste:=xlPasteValues Workbooks(fname).Activate Sheets("absence").Select Range("F2:T" & (d + 1)).Select Selection.Copy Application.ThisWorkbook.Activate Sheets("absence").Select Range("G" & e & ":U" & (e + d - 1)).Select Selection.PasteSpecial Paste:=xlPasteValues For c = e To (e + (d - 1)) Range("A" & c).Value = officename Next End If End If error: If (Not IsEmpty(fname)) Then Workbooks(fname).Close savechanges:=False End If Application.ThisWorkbook.Sheets("sheet1").Visible = False Next End If Application.EnableEvents = True Application.ScreenUpdating = True Sheet1.Worksheet_Calculate End Sub is the calling the worksheet a regonal problem like you stated, as this does work on 99.9% of computers I have run it on. "witek" wrote in message ... Anthony wrote: How do I get around this? check codename of this worksheet. It is (Name) property in properties (in VBE) . Probably it is Sheet1 or something around that and write. Workbooks(fname).Sheet1.select "witek" wrote in message ... Anthony wrote: Hi, The problem I am having is only occurring on 2 pc's. I have run the code on numerous other machines with no issues, but the annoying thing is I need it to run it on one of the pc's that is having the subscript out of range error. I have attached the two spreadsheets. The master file is meant to open up the office file and load in any information. The code is written so the user can select multiple files and it will work its way through them. The code is not very fancy but it was something I was putting together in a hurry and I was going to go back through the code and clean it up etc. What I don't understand is on the machines it failed on, the code in module 2 (Button2_click) fails during the function; e.g (sample of what I have descriped) fname="Tracker file" Workbooks.open(fname) 'ok Workbooks(fname).sheets("sheet1").select 'fails - subscript out of range Any help would be gratefully received. I apologise for having to attach files. Anthony p.s password is dragon1 different regional setting and "sheet1" is not "sheet1" ? |
Annoying Problem - Subscript out of range
I can't analize entire application.
Try what I wrote and tell if it works or not. Put breakpoint into line which couses error and try to execute next line step by step in immediate windows (Ctrl + G) Check if workbook is realy open, check what is the real name of sheet which you try to open, etc.. Anthony wrote: This is the actual code; Sub Button2_Click() ' ' Button2_Click Macro ' Macro recorded 21/05/2006 by Anthony & Ehly ' ' Dim OpenFilename As Variant Dim a, b, c, d, e As Integer Dim fname, officename As String Dim nocount As Integer On Error GoTo error Application.EnableEvents = False Application.ScreenUpdating = False OpenFilename = Application.GetOpenFilename("Excel Files (*.xls),*.xls", , "Open tracker files", , True) If IsArray(OpenFilename) Then For a = LBound(OpenFilename) To UBound(OpenFilename) Workbooks.Open (OpenFilename(a)) For b = 1 To Len(OpenFilename(a)) If (Mid$(OpenFilename(a), b, 1) = "\") Then c = b End If Next b fname = Right$(OpenFilename(a), Len(OpenFilename(a)) - c) fname = Left$(fname, Len(fname) - 4) Application.ThisWorkbook.Sheets("sheet1").Visible = True e = Application.ThisWorkbook.Sheets("sheet1").Cells(1, 1).Value + 2 If (Workbooks(fname).Sheets("sheet1").Cells(1, 2).Value = 492507) Then Workbooks(fname).Sheets("sheet1").Visible = True d = Workbooks(fname).Sheets("sheet1").Cells(1, 1).Value officename = Workbooks(fname).Sheets("sheet1").Cells(1, 3).Value If (d 0) Then Workbooks(fname).Sheets("sheet1").Select Range(Cells(2, 1), Cells(d + 1, 5)).Select Selection.Copy Application.ThisWorkbook.Activate Sheets("sheet1").Select Cells(Sheets("sheet1").Cells(1, 1).Value + 2, 1).Select ActiveSheet.Paste 'copy front page Workbooks(fname).Activate Sheets("absence").Select Range("A2:B" & (d + 1)).Select Selection.Copy Application.ThisWorkbook.Activate Sheets("absence").Select Range("B" & e & ":C" & (e + d - 1)).Select Selection.PasteSpecial Paste:=xlPasteValues Workbooks(fname).Activate Sheets("absence").Select Range("D2:D" & (d + 1)).Select Selection.Copy Application.ThisWorkbook.Activate Sheets("absence").Select Range("E" & e & ":E" & (e + d - 1)).Select Selection.PasteSpecial Paste:=xlPasteValues Workbooks(fname).Activate Sheets("absence").Select Range("F2:T" & (d + 1)).Select Selection.Copy Application.ThisWorkbook.Activate Sheets("absence").Select Range("G" & e & ":U" & (e + d - 1)).Select Selection.PasteSpecial Paste:=xlPasteValues For c = e To (e + (d - 1)) Range("A" & c).Value = officename Next End If End If error: If (Not IsEmpty(fname)) Then Workbooks(fname).Close savechanges:=False End If Application.ThisWorkbook.Sheets("sheet1").Visible = False Next End If Application.EnableEvents = True Application.ScreenUpdating = True Sheet1.Worksheet_Calculate End Sub is the calling the worksheet a regonal problem like you stated, as this does work on 99.9% of computers I have run it on. "witek" wrote in message ... Anthony wrote: How do I get around this? check codename of this worksheet. It is (Name) property in properties (in VBE) . Probably it is Sheet1 or something around that and write. Workbooks(fname).Sheet1.select "witek" wrote in message ... Anthony wrote: Hi, The problem I am having is only occurring on 2 pc's. I have run the code on numerous other machines with no issues, but the annoying thing is I need it to run it on one of the pc's that is having the subscript out of range error. I have attached the two spreadsheets. The master file is meant to open up the office file and load in any information. The code is written so the user can select multiple files and it will work its way through them. The code is not very fancy but it was something I was putting together in a hurry and I was going to go back through the code and clean it up etc. What I don't understand is on the machines it failed on, the code in module 2 (Button2_click) fails during the function; e.g (sample of what I have descriped) fname="Tracker file" Workbooks.open(fname) 'ok Workbooks(fname).sheets("sheet1").select 'fails - subscript out of range Any help would be gratefully received. I apologise for having to attach files. Anthony p.s password is dragon1 different regional setting and "sheet1" is not "sheet1" ? |
Annoying Problem - Subscript out of range
Thank you for the help you have given so far, but the problem I am having
only occurs on two computers, which I have limited access to. If I run the code to debug it, it runs perfectly everytime. The code I copied is only a segment attached to one button on the spreadsheet and its only this code which throws up the error (on only 2 pcs out of about 50) but sods law its one of the two it needs to run on. Breakpoints / watches etc I have done and when run on one of the problem pcs, it throws the error subscript out of range in the middle of the function, without any reason I can see. for example; fname = "TargetFile" workbooks.open(fname) 'works perfectly the next line of code I placed after this to test it failed which was workbooks(fname).close fname was still defined when I checked it during debugging and I never jumped out of the function for it to loose scoop. The workbook was visible after the open(fname) statement. Its not how to debug or what pages are called I am needing help with, but a second eye to see if I missed anything, because the next time I have access to one of the computers which throws the error is Saturday and only for about an hour. Its a pain of a problem, more due to lack of access of the problem pc. "witek" wrote in message ... I can't analize entire application. Try what I wrote and tell if it works or not. Put breakpoint into line which couses error and try to execute next line step by step in immediate windows (Ctrl + G) Check if workbook is realy open, check what is the real name of sheet which you try to open, etc.. Anthony wrote: This is the actual code; Sub Button2_Click() ' ' Button2_Click Macro ' Macro recorded 21/05/2006 by Anthony & Ehly ' ' Dim OpenFilename As Variant Dim a, b, c, d, e As Integer Dim fname, officename As String Dim nocount As Integer On Error GoTo error Application.EnableEvents = False Application.ScreenUpdating = False OpenFilename = Application.GetOpenFilename("Excel Files (*.xls),*.xls", , "Open tracker files", , True) If IsArray(OpenFilename) Then For a = LBound(OpenFilename) To UBound(OpenFilename) Workbooks.Open (OpenFilename(a)) For b = 1 To Len(OpenFilename(a)) If (Mid$(OpenFilename(a), b, 1) = "\") Then c = b End If Next b fname = Right$(OpenFilename(a), Len(OpenFilename(a)) - c) fname = Left$(fname, Len(fname) - 4) Application.ThisWorkbook.Sheets("sheet1").Visible = True e = Application.ThisWorkbook.Sheets("sheet1").Cells(1, 1).Value + 2 If (Workbooks(fname).Sheets("sheet1").Cells(1, 2).Value = 492507) Then Workbooks(fname).Sheets("sheet1").Visible = True d = Workbooks(fname).Sheets("sheet1").Cells(1, 1).Value officename = Workbooks(fname).Sheets("sheet1").Cells(1, 3).Value If (d 0) Then Workbooks(fname).Sheets("sheet1").Select Range(Cells(2, 1), Cells(d + 1, 5)).Select Selection.Copy Application.ThisWorkbook.Activate Sheets("sheet1").Select Cells(Sheets("sheet1").Cells(1, 1).Value + 2, 1).Select ActiveSheet.Paste 'copy front page Workbooks(fname).Activate Sheets("absence").Select Range("A2:B" & (d + 1)).Select Selection.Copy Application.ThisWorkbook.Activate Sheets("absence").Select Range("B" & e & ":C" & (e + d - 1)).Select Selection.PasteSpecial Paste:=xlPasteValues Workbooks(fname).Activate Sheets("absence").Select Range("D2:D" & (d + 1)).Select Selection.Copy Application.ThisWorkbook.Activate Sheets("absence").Select Range("E" & e & ":E" & (e + d - 1)).Select Selection.PasteSpecial Paste:=xlPasteValues Workbooks(fname).Activate Sheets("absence").Select Range("F2:T" & (d + 1)).Select Selection.Copy Application.ThisWorkbook.Activate Sheets("absence").Select Range("G" & e & ":U" & (e + d - 1)).Select Selection.PasteSpecial Paste:=xlPasteValues For c = e To (e + (d - 1)) Range("A" & c).Value = officename Next End If End If error: If (Not IsEmpty(fname)) Then Workbooks(fname).Close savechanges:=False End If Application.ThisWorkbook.Sheets("sheet1").Visible = False Next End If Application.EnableEvents = True Application.ScreenUpdating = True Sheet1.Worksheet_Calculate End Sub is the calling the worksheet a regonal problem like you stated, as this does work on 99.9% of computers I have run it on. "witek" wrote in message ... Anthony wrote: How do I get around this? check codename of this worksheet. It is (Name) property in properties (in VBE) . Probably it is Sheet1 or something around that and write. Workbooks(fname).Sheet1.select "witek" wrote in message ... Anthony wrote: Hi, The problem I am having is only occurring on 2 pc's. I have run the code on numerous other machines with no issues, but the annoying thing is I need it to run it on one of the pc's that is having the subscript out of range error. I have attached the two spreadsheets. The master file is meant to open up the office file and load in any information. The code is written so the user can select multiple files and it will work its way through them. The code is not very fancy but it was something I was putting together in a hurry and I was going to go back through the code and clean it up etc. What I don't understand is on the machines it failed on, the code in module 2 (Button2_click) fails during the function; e.g (sample of what I have descriped) fname="Tracker file" Workbooks.open(fname) 'ok Workbooks(fname).sheets("sheet1").select 'fails - subscript out of range Any help would be gratefully received. I apologise for having to attach files. Anthony p.s password is dragon1 different regional setting and "sheet1" is not "sheet1" ? |
Annoying Problem - Subscript out of range
Try commenting/deleting this line:
fname = Left$(fname, Len(fname) - 4) There's a windows setting that the user can specify to show extensions for known files. And your code may fail if you need the extension. But including the extension will always work. When you do this: Dim a, b, c, d, e As Integer It's equivalent to: Dim a as variant, b as variant, c as variant, d as variant, e As Integer I bet you wanted each of those to be counting numbers. It turns out that using integers even slows down modern computers--from what I've read, one of the first thing that the pc does is to convert those to Longs. So why not just do that at the start?? And you have lots of selections. And since you're selecting stuff, you have to make worksheets visible. And keep track of where you are. If you assign the workbook that you're opening to its own variable, you can refer to that variable (and even forget about keeping track of file names!). You have some variables (b, c, fName, noCount) that I don't use. And as a personal preference, I'd use more meaningful names for the variables. I would think that if d and e were named nicely, it would make it a bit easier to understand the code--maybe not now when it's fresh in your mind, but give it a couple of months and you'll see! Anyway, I didn't set up any test workbooks, but this code compiles for me and I think that it does what your original code did. You'll want to test it out, though. Option Explicit Sub Button2_Click() Dim OpenFilename As Variant Dim a As Long 'Dim b As Long 'Dim c As Long Dim d As Long Dim e As Long 'Dim fName As String Dim OfficeName As String 'Dim noCount As Long Dim tempWkbk As Workbook Dim RngToCopy As Range Application.EnableEvents = False Application.ScreenUpdating = False OpenFilename = Application.GetOpenFilename _ (filefilter:="Excel Files (*.xls),*.xls", _ Title:="Open tracker files", MultiSelect:=True) If IsArray(OpenFilename) Then 'if you don't select, you don't have to make visible. 'ThisWorkbook.Sheets("sheet1").Visible = True 'but even if you wanted to make it visible, move it out of the loop 'and only do it once For a = LBound(OpenFilename) To UBound(OpenFilename) Set tempWkbk = Workbooks.Open(OpenFilename(a)) e = ThisWorkbook.Sheets("sheet1").Cells(1, 1).Value + 2 If tempWkbk.Worksheets("sheet1").Cells(1, 2).Value = 492507 Then 'same here, don't bother making visible 'tempWkbk.Sheets("sheet1").Visible = True OfficeName = tempWkbk.Sheets("sheet1").Cells(1, 3).Value d = tempWkbk.Sheets("sheet1").Cells(1, 1).Value If d 0 Then With tempWkbk.Sheets("sheet1") Set RngToCopy = .Range(.Cells(2, 1), .Cells(d + 1, 5)) End With RngToCopy.Copy _ Destination:=ThisWorkbook.Sheets("Sheet1").Cells(e , 1) 'copy front page With tempWkbk.Worksheets("absence") Set RngToCopy = .Range("a2:b" & d + 1) End With RngToCopy.Copy ThisWorkbook.Worksheets("absence").Cells(e, "B") _ .PasteSpecial Paste:=xlPasteValues With tempWkbk.Worksheets("absence") Set RngToCopy = .Range("d2:d" & d + 1) End With RngToCopy.Copy ThisWorkbook.Worksheets("absense").Cells(e, "E") _ .PasteSpecial Paste:=xlPasteValues With tempWkbk.Worksheets("absence") Set RngToCopy = .Range("F2:t" & d + 1) End With RngToCopy.Copy ThisWorkbook.Worksheets("absense").Cells(e, "G") _ .PasteSpecial Paste:=xlPasteValues ThisWorkbook.Worksheets("absense").Range("A" & e) _ .Resize(d - 1, 1).Value = OfficeName End If End If tempWkbk.Close savechanges:=False Next a End If With Application .EnableEvents = True .ScreenUpdating = True .Calculate End With End Sub And I'm sure you've noticed that when you're pasting to a range manually that excel will expand the range to match the size of the copied range. The same thing happens in code--so I've only specified the topleft cell of the ..pastespecial ranges. Anthony wrote: This is the actual code; Sub Button2_Click() ' ' Button2_Click Macro ' Macro recorded 21/05/2006 by Anthony & Ehly ' ' Dim OpenFilename As Variant Dim a, b, c, d, e As Integer Dim fname, officename As String Dim nocount As Integer On Error GoTo error Application.EnableEvents = False Application.ScreenUpdating = False OpenFilename = Application.GetOpenFilename("Excel Files (*.xls),*.xls", , "Open tracker files", , True) If IsArray(OpenFilename) Then For a = LBound(OpenFilename) To UBound(OpenFilename) Workbooks.Open (OpenFilename(a)) For b = 1 To Len(OpenFilename(a)) If (Mid$(OpenFilename(a), b, 1) = "\") Then c = b End If Next b fname = Right$(OpenFilename(a), Len(OpenFilename(a)) - c) fname = Left$(fname, Len(fname) - 4) Application.ThisWorkbook.Sheets("sheet1").Visible = True e = Application.ThisWorkbook.Sheets("sheet1").Cells(1, 1).Value + 2 If (Workbooks(fname).Sheets("sheet1").Cells(1, 2).Value = 492507) Then Workbooks(fname).Sheets("sheet1").Visible = True d = Workbooks(fname).Sheets("sheet1").Cells(1, 1).Value officename = Workbooks(fname).Sheets("sheet1").Cells(1, 3).Value If (d 0) Then Workbooks(fname).Sheets("sheet1").Select Range(Cells(2, 1), Cells(d + 1, 5)).Select Selection.Copy Application.ThisWorkbook.Activate Sheets("sheet1").Select Cells(Sheets("sheet1").Cells(1, 1).Value + 2, 1).Select ActiveSheet.Paste 'copy front page Workbooks(fname).Activate Sheets("absence").Select Range("A2:B" & (d + 1)).Select Selection.Copy Application.ThisWorkbook.Activate Sheets("absence").Select Range("B" & e & ":C" & (e + d - 1)).Select Selection.PasteSpecial Paste:=xlPasteValues Workbooks(fname).Activate Sheets("absence").Select Range("D2:D" & (d + 1)).Select Selection.Copy Application.ThisWorkbook.Activate Sheets("absence").Select Range("E" & e & ":E" & (e + d - 1)).Select Selection.PasteSpecial Paste:=xlPasteValues Workbooks(fname).Activate Sheets("absence").Select Range("F2:T" & (d + 1)).Select Selection.Copy Application.ThisWorkbook.Activate Sheets("absence").Select Range("G" & e & ":U" & (e + d - 1)).Select Selection.PasteSpecial Paste:=xlPasteValues For c = e To (e + (d - 1)) Range("A" & c).Value = officename Next End If End If error: If (Not IsEmpty(fname)) Then Workbooks(fname).Close savechanges:=False End If Application.ThisWorkbook.Sheets("sheet1").Visible = False Next End If Application.EnableEvents = True Application.ScreenUpdating = True Sheet1.Worksheet_Calculate End Sub is the calling the worksheet a regonal problem like you stated, as this does work on 99.9% of computers I have run it on. "witek" wrote in message ... Anthony wrote: How do I get around this? check codename of this worksheet. It is (Name) property in properties (in VBE) . Probably it is Sheet1 or something around that and write. Workbooks(fname).Sheet1.select "witek" wrote in message ... Anthony wrote: Hi, The problem I am having is only occurring on 2 pc's. I have run the code on numerous other machines with no issues, but the annoying thing is I need it to run it on one of the pc's that is having the subscript out of range error. I have attached the two spreadsheets. The master file is meant to open up the office file and load in any information. The code is written so the user can select multiple files and it will work its way through them. The code is not very fancy but it was something I was putting together in a hurry and I was going to go back through the code and clean it up etc. What I don't understand is on the machines it failed on, the code in module 2 (Button2_click) fails during the function; e.g (sample of what I have descriped) fname="Tracker file" Workbooks.open(fname) 'ok Workbooks(fname).sheets("sheet1").select 'fails - subscript out of range Any help would be gratefully received. I apologise for having to attach files. Anthony p.s password is dragon1 different regional setting and "sheet1" is not "sheet1" ? -- Dave Peterson |
Annoying Problem - Subscript out of range
Thank you so much, just what I needed. A few different ways of doing things,
which I will take on board and use in future. thanks Anthony "Dave Peterson" wrote in message ... Try commenting/deleting this line: fname = Left$(fname, Len(fname) - 4) There's a windows setting that the user can specify to show extensions for known files. And your code may fail if you need the extension. But including the extension will always work. When you do this: Dim a, b, c, d, e As Integer It's equivalent to: Dim a as variant, b as variant, c as variant, d as variant, e As Integer I bet you wanted each of those to be counting numbers. It turns out that using integers even slows down modern computers--from what I've read, one of the first thing that the pc does is to convert those to Longs. So why not just do that at the start?? And you have lots of selections. And since you're selecting stuff, you have to make worksheets visible. And keep track of where you are. If you assign the workbook that you're opening to its own variable, you can refer to that variable (and even forget about keeping track of file names!). You have some variables (b, c, fName, noCount) that I don't use. And as a personal preference, I'd use more meaningful names for the variables. I would think that if d and e were named nicely, it would make it a bit easier to understand the code--maybe not now when it's fresh in your mind, but give it a couple of months and you'll see! Anyway, I didn't set up any test workbooks, but this code compiles for me and I think that it does what your original code did. You'll want to test it out, though. Option Explicit Sub Button2_Click() Dim OpenFilename As Variant Dim a As Long 'Dim b As Long 'Dim c As Long Dim d As Long Dim e As Long 'Dim fName As String Dim OfficeName As String 'Dim noCount As Long Dim tempWkbk As Workbook Dim RngToCopy As Range Application.EnableEvents = False Application.ScreenUpdating = False OpenFilename = Application.GetOpenFilename _ (filefilter:="Excel Files (*.xls),*.xls", _ Title:="Open tracker files", MultiSelect:=True) If IsArray(OpenFilename) Then 'if you don't select, you don't have to make visible. 'ThisWorkbook.Sheets("sheet1").Visible = True 'but even if you wanted to make it visible, move it out of the loop 'and only do it once For a = LBound(OpenFilename) To UBound(OpenFilename) Set tempWkbk = Workbooks.Open(OpenFilename(a)) e = ThisWorkbook.Sheets("sheet1").Cells(1, 1).Value + 2 If tempWkbk.Worksheets("sheet1").Cells(1, 2).Value = 492507 Then 'same here, don't bother making visible 'tempWkbk.Sheets("sheet1").Visible = True OfficeName = tempWkbk.Sheets("sheet1").Cells(1, 3).Value d = tempWkbk.Sheets("sheet1").Cells(1, 1).Value If d 0 Then With tempWkbk.Sheets("sheet1") Set RngToCopy = .Range(.Cells(2, 1), .Cells(d + 1, 5)) End With RngToCopy.Copy _ Destination:=ThisWorkbook.Sheets("Sheet1").Cells(e , 1) 'copy front page With tempWkbk.Worksheets("absence") Set RngToCopy = .Range("a2:b" & d + 1) End With RngToCopy.Copy ThisWorkbook.Worksheets("absence").Cells(e, "B") _ .PasteSpecial Paste:=xlPasteValues With tempWkbk.Worksheets("absence") Set RngToCopy = .Range("d2:d" & d + 1) End With RngToCopy.Copy ThisWorkbook.Worksheets("absense").Cells(e, "E") _ .PasteSpecial Paste:=xlPasteValues With tempWkbk.Worksheets("absence") Set RngToCopy = .Range("F2:t" & d + 1) End With RngToCopy.Copy ThisWorkbook.Worksheets("absense").Cells(e, "G") _ .PasteSpecial Paste:=xlPasteValues ThisWorkbook.Worksheets("absense").Range("A" & e) _ .Resize(d - 1, 1).Value = OfficeName End If End If tempWkbk.Close savechanges:=False Next a End If With Application .EnableEvents = True .ScreenUpdating = True .Calculate End With End Sub And I'm sure you've noticed that when you're pasting to a range manually that excel will expand the range to match the size of the copied range. The same thing happens in code--so I've only specified the topleft cell of the .pastespecial ranges. Anthony wrote: This is the actual code; Sub Button2_Click() ' ' Button2_Click Macro ' Macro recorded 21/05/2006 by Anthony & Ehly ' ' Dim OpenFilename As Variant Dim a, b, c, d, e As Integer Dim fname, officename As String Dim nocount As Integer On Error GoTo error Application.EnableEvents = False Application.ScreenUpdating = False OpenFilename = Application.GetOpenFilename("Excel Files (*.xls),*.xls", , "Open tracker files", , True) If IsArray(OpenFilename) Then For a = LBound(OpenFilename) To UBound(OpenFilename) Workbooks.Open (OpenFilename(a)) For b = 1 To Len(OpenFilename(a)) If (Mid$(OpenFilename(a), b, 1) = "\") Then c = b End If Next b fname = Right$(OpenFilename(a), Len(OpenFilename(a)) - c) fname = Left$(fname, Len(fname) - 4) Application.ThisWorkbook.Sheets("sheet1").Visible = True e = Application.ThisWorkbook.Sheets("sheet1").Cells(1, 1).Value + 2 If (Workbooks(fname).Sheets("sheet1").Cells(1, 2).Value = 492507) Then Workbooks(fname).Sheets("sheet1").Visible = True d = Workbooks(fname).Sheets("sheet1").Cells(1, 1).Value officename = Workbooks(fname).Sheets("sheet1").Cells(1, 3).Value If (d 0) Then Workbooks(fname).Sheets("sheet1").Select Range(Cells(2, 1), Cells(d + 1, 5)).Select Selection.Copy Application.ThisWorkbook.Activate Sheets("sheet1").Select Cells(Sheets("sheet1").Cells(1, 1).Value + 2, 1).Select ActiveSheet.Paste 'copy front page Workbooks(fname).Activate Sheets("absence").Select Range("A2:B" & (d + 1)).Select Selection.Copy Application.ThisWorkbook.Activate Sheets("absence").Select Range("B" & e & ":C" & (e + d - 1)).Select Selection.PasteSpecial Paste:=xlPasteValues Workbooks(fname).Activate Sheets("absence").Select Range("D2:D" & (d + 1)).Select Selection.Copy Application.ThisWorkbook.Activate Sheets("absence").Select Range("E" & e & ":E" & (e + d - 1)).Select Selection.PasteSpecial Paste:=xlPasteValues Workbooks(fname).Activate Sheets("absence").Select Range("F2:T" & (d + 1)).Select Selection.Copy Application.ThisWorkbook.Activate Sheets("absence").Select Range("G" & e & ":U" & (e + d - 1)).Select Selection.PasteSpecial Paste:=xlPasteValues For c = e To (e + (d - 1)) Range("A" & c).Value = officename Next End If End If error: If (Not IsEmpty(fname)) Then Workbooks(fname).Close savechanges:=False End If Application.ThisWorkbook.Sheets("sheet1").Visible = False Next End If Application.EnableEvents = True Application.ScreenUpdating = True Sheet1.Worksheet_Calculate End Sub is the calling the worksheet a regonal problem like you stated, as this does work on 99.9% of computers I have run it on. "witek" wrote in message ... Anthony wrote: How do I get around this? check codename of this worksheet. It is (Name) property in properties (in VBE) . Probably it is Sheet1 or something around that and write. Workbooks(fname).Sheet1.select "witek" wrote in message ... Anthony wrote: Hi, The problem I am having is only occurring on 2 pc's. I have run the code on numerous other machines with no issues, but the annoying thing is I need it to run it on one of the pc's that is having the subscript out of range error. I have attached the two spreadsheets. The master file is meant to open up the office file and load in any information. The code is written so the user can select multiple files and it will work its way through them. The code is not very fancy but it was something I was putting together in a hurry and I was going to go back through the code and clean it up etc. What I don't understand is on the machines it failed on, the code in module 2 (Button2_click) fails during the function; e.g (sample of what I have descriped) fname="Tracker file" Workbooks.open(fname) 'ok Workbooks(fname).sheets("sheet1").select 'fails - subscript out of range Any help would be gratefully received. I apologise for having to attach files. Anthony p.s password is dragon1 different regional setting and "sheet1" is not "sheet1" ? -- Dave Peterson |
Annoying Problem - Subscript out of range
Worked perfectly. Thank you so much.
Anthony "Dave Peterson" wrote in message ... Try commenting/deleting this line: fname = Left$(fname, Len(fname) - 4) There's a windows setting that the user can specify to show extensions for known files. And your code may fail if you need the extension. But including the extension will always work. When you do this: Dim a, b, c, d, e As Integer It's equivalent to: Dim a as variant, b as variant, c as variant, d as variant, e As Integer I bet you wanted each of those to be counting numbers. It turns out that using integers even slows down modern computers--from what I've read, one of the first thing that the pc does is to convert those to Longs. So why not just do that at the start?? And you have lots of selections. And since you're selecting stuff, you have to make worksheets visible. And keep track of where you are. If you assign the workbook that you're opening to its own variable, you can refer to that variable (and even forget about keeping track of file names!). You have some variables (b, c, fName, noCount) that I don't use. And as a personal preference, I'd use more meaningful names for the variables. I would think that if d and e were named nicely, it would make it a bit easier to understand the code--maybe not now when it's fresh in your mind, but give it a couple of months and you'll see! Anyway, I didn't set up any test workbooks, but this code compiles for me and I think that it does what your original code did. You'll want to test it out, though. Option Explicit Sub Button2_Click() Dim OpenFilename As Variant Dim a As Long 'Dim b As Long 'Dim c As Long Dim d As Long Dim e As Long 'Dim fName As String Dim OfficeName As String 'Dim noCount As Long Dim tempWkbk As Workbook Dim RngToCopy As Range Application.EnableEvents = False Application.ScreenUpdating = False OpenFilename = Application.GetOpenFilename _ (filefilter:="Excel Files (*.xls),*.xls", _ Title:="Open tracker files", MultiSelect:=True) If IsArray(OpenFilename) Then 'if you don't select, you don't have to make visible. 'ThisWorkbook.Sheets("sheet1").Visible = True 'but even if you wanted to make it visible, move it out of the loop 'and only do it once For a = LBound(OpenFilename) To UBound(OpenFilename) Set tempWkbk = Workbooks.Open(OpenFilename(a)) e = ThisWorkbook.Sheets("sheet1").Cells(1, 1).Value + 2 If tempWkbk.Worksheets("sheet1").Cells(1, 2).Value = 492507 Then 'same here, don't bother making visible 'tempWkbk.Sheets("sheet1").Visible = True OfficeName = tempWkbk.Sheets("sheet1").Cells(1, 3).Value d = tempWkbk.Sheets("sheet1").Cells(1, 1).Value If d 0 Then With tempWkbk.Sheets("sheet1") Set RngToCopy = .Range(.Cells(2, 1), .Cells(d + 1, 5)) End With RngToCopy.Copy _ Destination:=ThisWorkbook.Sheets("Sheet1").Cells(e , 1) 'copy front page With tempWkbk.Worksheets("absence") Set RngToCopy = .Range("a2:b" & d + 1) End With RngToCopy.Copy ThisWorkbook.Worksheets("absence").Cells(e, "B") _ .PasteSpecial Paste:=xlPasteValues With tempWkbk.Worksheets("absence") Set RngToCopy = .Range("d2:d" & d + 1) End With RngToCopy.Copy ThisWorkbook.Worksheets("absense").Cells(e, "E") _ .PasteSpecial Paste:=xlPasteValues With tempWkbk.Worksheets("absence") Set RngToCopy = .Range("F2:t" & d + 1) End With RngToCopy.Copy ThisWorkbook.Worksheets("absense").Cells(e, "G") _ .PasteSpecial Paste:=xlPasteValues ThisWorkbook.Worksheets("absense").Range("A" & e) _ .Resize(d - 1, 1).Value = OfficeName End If End If tempWkbk.Close savechanges:=False Next a End If With Application .EnableEvents = True .ScreenUpdating = True .Calculate End With End Sub And I'm sure you've noticed that when you're pasting to a range manually that excel will expand the range to match the size of the copied range. The same thing happens in code--so I've only specified the topleft cell of the .pastespecial ranges. Anthony wrote: This is the actual code; Sub Button2_Click() ' ' Button2_Click Macro ' Macro recorded 21/05/2006 by Anthony & Ehly ' ' Dim OpenFilename As Variant Dim a, b, c, d, e As Integer Dim fname, officename As String Dim nocount As Integer On Error GoTo error Application.EnableEvents = False Application.ScreenUpdating = False OpenFilename = Application.GetOpenFilename("Excel Files (*.xls),*.xls", , "Open tracker files", , True) If IsArray(OpenFilename) Then For a = LBound(OpenFilename) To UBound(OpenFilename) Workbooks.Open (OpenFilename(a)) For b = 1 To Len(OpenFilename(a)) If (Mid$(OpenFilename(a), b, 1) = "\") Then c = b End If Next b fname = Right$(OpenFilename(a), Len(OpenFilename(a)) - c) fname = Left$(fname, Len(fname) - 4) Application.ThisWorkbook.Sheets("sheet1").Visible = True e = Application.ThisWorkbook.Sheets("sheet1").Cells(1, 1).Value + 2 If (Workbooks(fname).Sheets("sheet1").Cells(1, 2).Value = 492507) Then Workbooks(fname).Sheets("sheet1").Visible = True d = Workbooks(fname).Sheets("sheet1").Cells(1, 1).Value officename = Workbooks(fname).Sheets("sheet1").Cells(1, 3).Value If (d 0) Then Workbooks(fname).Sheets("sheet1").Select Range(Cells(2, 1), Cells(d + 1, 5)).Select Selection.Copy Application.ThisWorkbook.Activate Sheets("sheet1").Select Cells(Sheets("sheet1").Cells(1, 1).Value + 2, 1).Select ActiveSheet.Paste 'copy front page Workbooks(fname).Activate Sheets("absence").Select Range("A2:B" & (d + 1)).Select Selection.Copy Application.ThisWorkbook.Activate Sheets("absence").Select Range("B" & e & ":C" & (e + d - 1)).Select Selection.PasteSpecial Paste:=xlPasteValues Workbooks(fname).Activate Sheets("absence").Select Range("D2:D" & (d + 1)).Select Selection.Copy Application.ThisWorkbook.Activate Sheets("absence").Select Range("E" & e & ":E" & (e + d - 1)).Select Selection.PasteSpecial Paste:=xlPasteValues Workbooks(fname).Activate Sheets("absence").Select Range("F2:T" & (d + 1)).Select Selection.Copy Application.ThisWorkbook.Activate Sheets("absence").Select Range("G" & e & ":U" & (e + d - 1)).Select Selection.PasteSpecial Paste:=xlPasteValues For c = e To (e + (d - 1)) Range("A" & c).Value = officename Next End If End If error: If (Not IsEmpty(fname)) Then Workbooks(fname).Close savechanges:=False End If Application.ThisWorkbook.Sheets("sheet1").Visible = False Next End If Application.EnableEvents = True Application.ScreenUpdating = True Sheet1.Worksheet_Calculate End Sub is the calling the worksheet a regonal problem like you stated, as this does work on 99.9% of computers I have run it on. "witek" wrote in message ... Anthony wrote: How do I get around this? check codename of this worksheet. It is (Name) property in properties (in VBE) . Probably it is Sheet1 or something around that and write. Workbooks(fname).Sheet1.select "witek" wrote in message ... Anthony wrote: Hi, The problem I am having is only occurring on 2 pc's. I have run the code on numerous other machines with no issues, but the annoying thing is I need it to run it on one of the pc's that is having the subscript out of range error. I have attached the two spreadsheets. The master file is meant to open up the office file and load in any information. The code is written so the user can select multiple files and it will work its way through them. The code is not very fancy but it was something I was putting together in a hurry and I was going to go back through the code and clean it up etc. What I don't understand is on the machines it failed on, the code in module 2 (Button2_click) fails during the function; e.g (sample of what I have descriped) fname="Tracker file" Workbooks.open(fname) 'ok Workbooks(fname).sheets("sheet1").select 'fails - subscript out of range Any help would be gratefully received. I apologise for having to attach files. Anthony p.s password is dragon1 different regional setting and "sheet1" is not "sheet1" ? -- Dave Peterson |
| All times are GMT +1. The time now is 07:38 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com